34
35:- module(prolog_pack,
36 [ pack_list_installed/0,
37 pack_info/1, 38 pack_list/1, 39 pack_search/1, 40 pack_install/1, 41 pack_install/2, 42 pack_upgrade/1, 43 pack_rebuild/1, 44 pack_rebuild/0, 45 pack_remove/1, 46 pack_property/2, 47
48 pack_url_file/2 49 ]). 50:- use_module(library(apply)). 51:- use_module(library(error)). 52:- use_module(library(process)). 53:- use_module(library(option)). 54:- use_module(library(readutil)). 55:- use_module(library(lists)). 56:- use_module(library(filesex)). 57:- use_module(library(xpath)). 58:- use_module(library(settings)). 59:- use_module(library(uri)). 60:- use_module(library(http/http_open)). 61:- use_module(library(http/json)). 62:- use_module(library(http/http_client), []). 63:- if(exists_source(library(archive))). 64:- use_module(library(archive)). 65:- endif. 66
67
82
83:- multifile
84 environment/2. 85
86:- dynamic
87 pack_requires/2, 88 pack_provides_db/2. 89
90
91 94
95:- setting(server, atom, 'http://www.swi-prolog.org/pack/',
96 'Server to exchange pack information'). 97
98
99 102
106
107current_pack(Pack) :-
108 '$pack':pack(Pack, _).
109
117
118pack_list_installed :-
119 findall(Pack, current_pack(Pack), Packages0),
120 Packages0 \== [],
121 !,
122 sort(Packages0, Packages),
123 length(Packages, Count),
124 format('Installed packages (~D):~n~n', [Count]),
125 maplist(pack_info(list), Packages),
126 validate_dependencies.
127pack_list_installed :-
128 print_message(informational, pack(no_packages_installed)).
129
133
134pack_info(Name) :-
135 pack_info(info, Name).
136
137pack_info(Level, Name) :-
138 must_be(atom, Name),
139 findall(Info, pack_info(Name, Level, Info), Infos0),
140 ( Infos0 == []
141 -> print_message(warning, pack(no_pack_installed(Name))),
142 fail
143 ; true
144 ),
145 update_dependency_db(Name, Infos0),
146 findall(Def, pack_default(Level, Infos, Def), Defs),
147 append(Infos0, Defs, Infos1),
148 sort(Infos1, Infos),
149 show_info(Name, Infos, [info(Level)]).
150
151
152show_info(_Name, _Properties, Options) :-
153 option(silent(true), Options),
154 !.
155show_info(Name, Properties, Options) :-
156 option(info(list), Options),
157 !,
158 memberchk(title(Title), Properties),
159 memberchk(version(Version), Properties),
160 format('i ~w@~w ~28|- ~w~n', [Name, Version, Title]).
161show_info(Name, Properties, _) :-
162 !,
163 print_property_value('Package'-'~w', [Name]),
164 findall(Term, pack_level_info(info, Term, _, _), Terms),
165 maplist(print_property(Properties), Terms).
166
167print_property(_, nl) :-
168 !,
169 format('~n').
170print_property(Properties, Term) :-
171 findall(Term, member(Term, Properties), Terms),
172 Terms \== [],
173 !,
174 pack_level_info(_, Term, LabelFmt, _Def),
175 ( LabelFmt = Label-FmtElem
176 -> true
177 ; Label = LabelFmt,
178 FmtElem = '~w'
179 ),
180 multi_valued(Terms, FmtElem, FmtList, Values),
181 atomic_list_concat(FmtList, ', ', Fmt),
182 print_property_value(Label-Fmt, Values).
183print_property(_, _).
184
185multi_valued([H], LabelFmt, [LabelFmt], Values) :-
186 !,
187 H =.. [_|Values].
188multi_valued([H|T], LabelFmt, [LabelFmt|LT], Values) :-
189 H =.. [_|VH],
190 append(VH, MoreValues, Values),
191 multi_valued(T, LabelFmt, LT, MoreValues).
192
193
194pvalue_column(24).
195print_property_value(Prop-Fmt, Values) :-
196 !,
197 pvalue_column(C),
198 atomic_list_concat(['~w:~t~*|', Fmt, '~n'], Format),
199 format(Format, [Prop,C|Values]).
200
201pack_info(Name, Level, Info) :-
202 '$pack':pack(Name, BaseDir),
203 ( Info = directory(BaseDir)
204 ; pack_info_term(BaseDir, Info)
205 ),
206 pack_level_info(Level, Info, _Format, _Default).
207
208:- public pack_level_info/4. 209
210pack_level_info(_, title(_), 'Title', '<no title>').
211pack_level_info(_, version(_), 'Installed version', '<unknown>').
212pack_level_info(info, directory(_), 'Installed in directory', -).
213pack_level_info(info, author(_, _), 'Author'-'~w <~w>', -).
214pack_level_info(info, maintainer(_, _), 'Maintainer'-'~w <~w>', -).
215pack_level_info(info, packager(_, _), 'Packager'-'~w <~w>', -).
216pack_level_info(info, home(_), 'Home page', -).
217pack_level_info(info, download(_), 'Download URL', -).
218pack_level_info(_, provides(_), 'Provides', -).
219pack_level_info(_, requires(_), 'Requires', -).
220pack_level_info(_, conflicts(_), 'Conflicts with', -).
221pack_level_info(_, replaces(_), 'Replaces packages', -).
222pack_level_info(info, library(_), 'Provided libraries', -).
223
224pack_default(Level, Infos, Def) :-
225 pack_level_info(Level, ITerm, _Format, Def),
226 Def \== (-),
227 \+ memberchk(ITerm, Infos).
228
232
233pack_info_term(BaseDir, Info) :-
234 directory_file_path(BaseDir, 'pack.pl', InfoFile),
235 catch(
236 setup_call_cleanup(
237 open(InfoFile, read, In),
238 term_in_stream(In, Info),
239 close(In)),
240 error(existence_error(source_sink, InfoFile), _),
241 ( print_message(error, pack(no_meta_data(BaseDir))),
242 fail
243 )).
244pack_info_term(BaseDir, library(Lib)) :-
245 atom_concat(BaseDir, '/prolog/', LibDir),
246 atom_concat(LibDir, '*.pl', Pattern),
247 expand_file_name(Pattern, Files),
248 maplist(atom_concat(LibDir), Plain, Files),
249 convlist(base_name, Plain, Libs),
250 member(Lib, Libs).
251
252base_name(File, Base) :-
253 file_name_extension(Base, pl, File).
254
255term_in_stream(In, Term) :-
256 repeat,
257 read_term(In, Term0, []),
258 ( Term0 == end_of_file
259 -> !, fail
260 ; Term = Term0,
261 valid_info_term(Term0)
262 ).
263
264valid_info_term(Term) :-
265 Term =.. [Name|Args],
266 same_length(Args, Types),
267 Decl =.. [Name|Types],
268 ( pack_info_term(Decl)
269 -> maplist(valid_info_arg, Types, Args)
270 ; print_message(warning, pack(invalid_info(Term))),
271 fail
272 ).
273
274valid_info_arg(Type, Arg) :-
275 must_be(Type, Arg).
276
281
282pack_info_term(name(atom)). 283pack_info_term(title(atom)).
284pack_info_term(keywords(list(atom))).
285pack_info_term(description(list(atom))).
286pack_info_term(version(version)).
287pack_info_term(author(atom, email_or_url)). 288pack_info_term(maintainer(atom, email_or_url)).
289pack_info_term(packager(atom, email_or_url)).
290pack_info_term(home(atom)). 291pack_info_term(download(atom)). 292pack_info_term(provides(atom)). 293pack_info_term(requires(dependency)).
294pack_info_term(conflicts(dependency)). 295pack_info_term(replaces(atom)). 296pack_info_term(autoload(boolean)). 297
298:- multifile
299 error:has_type/2. 300
301error:has_type(version, Version) :-
302 atom(Version),
303 version_data(Version, _Data).
304error:has_type(email_or_url, Address) :-
305 atom(Address),
306 ( sub_atom(Address, _, _, _, @)
307 -> true
308 ; uri_is_global(Address)
309 ).
310error:has_type(dependency, Value) :-
311 is_dependency(Value, _Token, _Version).
312
313version_data(Version, version(Data)) :-
314 atomic_list_concat(Parts, '.', Version),
315 maplist(atom_number, Parts, Data).
316
317is_dependency(Token, Token, *) :-
318 atom(Token).
319is_dependency(Term, Token, VersionCmp) :-
320 Term =.. [Op,Token,Version],
321 cmp(Op, _),
322 version_data(Version, _),
323 VersionCmp =.. [Op,Version].
324
325cmp(<, @<).
326cmp(=<, @=<).
327cmp(==, ==).
328cmp(>=, @>=).
329cmp(>, @>).
330
331
332 335
362
363pack_list(Query) :-
364 pack_search(Query).
365
366pack_search(Query) :-
367 query_pack_server(search(Query), Result, []),
368 ( Result == false
369 -> ( local_search(Query, Packs),
370 Packs \== []
371 -> forall(member(pack(Pack, Stat, Title, Version, _), Packs),
372 format('~w ~w@~w ~28|- ~w~n',
373 [Stat, Pack, Version, Title]))
374 ; print_message(warning, pack(search_no_matches(Query)))
375 )
376 ; Result = true(Hits),
377 local_search(Query, Local),
378 append(Hits, Local, All),
379 sort(All, Sorted),
380 list_hits(Sorted)
381 ).
382
383list_hits([]).
384list_hits([ pack(Pack, i, Title, Version, _),
385 pack(Pack, p, Title, Version, _)
386 | More
387 ]) :-
388 !,
389 format('i ~w@~w ~28|- ~w~n', [Pack, Version, Title]),
390 list_hits(More).
391list_hits([ pack(Pack, i, Title, VersionI, _),
392 pack(Pack, p, _, VersionS, _)
393 | More
394 ]) :-
395 !,
396 version_data(VersionI, VDI),
397 version_data(VersionS, VDS),
398 ( VDI @< VDS
399 -> Tag = ('U')
400 ; Tag = ('A')
401 ),
402 format('~w ~w@~w(~w) ~28|- ~w~n', [Tag, Pack, VersionI, VersionS, Title]),
403 list_hits(More).
404list_hits([ pack(Pack, i, Title, VersionI, _)
405 | More
406 ]) :-
407 !,
408 format('l ~w@~w ~28|- ~w~n', [Pack, VersionI, Title]),
409 list_hits(More).
410list_hits([pack(Pack, Stat, Title, Version, _)|More]) :-
411 format('~w ~w@~w ~28|- ~w~n', [Stat, Pack, Version, Title]),
412 list_hits(More).
413
414
415local_search(Query, Packs) :-
416 findall(Pack, matching_installed_pack(Query, Pack), Packs).
417
418matching_installed_pack(Query, pack(Pack, i, Title, Version, URL)) :-
419 current_pack(Pack),
420 findall(Term,
421 ( pack_info(Pack, _, Term),
422 search_info(Term)
423 ), Info),
424 ( sub_atom_icasechk(Pack, _, Query)
425 -> true
426 ; memberchk(title(Title), Info),
427 sub_atom_icasechk(Title, _, Query)
428 ),
429 option(title(Title), Info, '<no title>'),
430 option(version(Version), Info, '<no version>'),
431 option(download(URL), Info, '<no download url>').
432
433search_info(title(_)).
434search_info(version(_)).
435search_info(download(_)).
436
437
438 441
457
458pack_install(Spec) :-
459 pack_default_options(Spec, Pack, [], Options),
460 pack_install(Pack, [pack(Pack)|Options]).
461
466
467pack_default_options(_Spec, Pack, OptsIn, Options) :-
468 option(already_installed(pack(Pack,_Version)), OptsIn),
469 !,
470 Options = OptsIn.
471pack_default_options(_Spec, Pack, OptsIn, Options) :-
472 option(url(URL), OptsIn),
473 !,
474 ( option(git(_), OptsIn)
475 -> Options = OptsIn
476 ; git_url(URL, Pack)
477 -> Options = [git(true)|OptsIn]
478 ; Options = OptsIn
479 ),
480 ( nonvar(Pack)
481 -> true
482 ; option(pack(Pack), Options)
483 -> true
484 ; pack_version_file(Pack, _Version, URL)
485 ).
486pack_default_options(Archive, Pack, _, Options) :- 487 must_be(atom, Archive),
488 expand_file_name(Archive, [File]),
489 exists_file(File),
490 !,
491 pack_version_file(Pack, Version, File),
492 uri_file_name(FileURL, File),
493 Options = [url(FileURL), version(Version)].
494pack_default_options(URL, Pack, _, Options) :-
495 git_url(URL, Pack),
496 !,
497 Options = [git(true), url(URL)].
498pack_default_options(FileURL, Pack, _, Options) :- 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) :- 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) :- 516 \+ uri_is_global(Pack), 517 query_pack_server(locate(Pack), Reply, OptsIn),
518 ( Reply = true(Results)
519 -> pack_select_candidate(Pack, Results, OptsIn, Options)
520 ; print_message(warning, pack(no_match(Pack))),
521 fail
522 ).
523
524version_options(Version, Version, [version(Version)]) :- !.
525version_options(Version, _, [version(Version)]) :-
526 Version = version(List),
527 maplist(integer, List),
528 !.
529version_options(_, _, []).
530
534
535pack_select_candidate(Pack, [Version-_|_], Options,
536 [already_installed(pack(Pack, Installed))|Options]) :-
537 current_pack(Pack),
538 pack_info(Pack, _, version(InstalledAtom)),
539 atom_version(InstalledAtom, Installed),
540 Installed @>= Version,
541 !.
542pack_select_candidate(Pack, Available, Options, OptsOut) :-
543 option(url(URL), Options),
544 memberchk(_Version-URLs, Available),
545 memberchk(URL, URLs),
546 !,
547 ( git_url(URL, Pack)
548 -> Extra = [git(true)]
549 ; Extra = []
550 ),
551 OptsOut = [url(URL), inquiry(true) | Extra].
552pack_select_candidate(Pack, [Version-[URL]|_], Options,
553 [url(URL), git(true), inquiry(true)]) :-
554 git_url(URL, Pack),
555 !,
556 confirm(install_from(Pack, Version, git(URL)), yes, Options).
557pack_select_candidate(Pack, [Version-[URL]|More], Options,
558 [url(URL), inquiry(true)]) :-
559 ( More == []
560 -> !
561 ; true
562 ),
563 confirm(install_from(Pack, Version, URL), yes, Options),
564 !.
565pack_select_candidate(Pack, [Version-URLs|_], Options,
566 [url(URL), inquiry(true)|Rest]) :-
567 maplist(url_menu_item, URLs, Tagged),
568 append(Tagged, [cancel=cancel], Menu),
569 Menu = [Default=_|_],
570 menu(pack(select_install_from(Pack, Version)),
571 Menu, Default, Choice, Options),
572 ( Choice == cancel
573 -> fail
574 ; Choice = git(URL)
575 -> Rest = [git(true)]
576 ; Choice = URL,
577 Rest = []
578 ).
579
(URL, git(URL)=install_from(git(URL))) :-
581 git_url(URL, _),
582 !.
583url_menu_item(URL, URL=install_from(URL)).
584
585
613
614pack_install(Spec, Options) :-
615 pack_default_options(Spec, Pack, Options, DefOptions),
616 ( option(already_installed(Installed), DefOptions)
617 -> print_message(informational, pack(already_installed(Installed)))
618 ; merge_options(Options, DefOptions, PackOptions),
619 update_dependency_db,
620 pack_install_dir(PackDir, PackOptions),
621 pack_install(Pack, PackDir, PackOptions)
622 ).
623
624pack_install_dir(PackDir, Options) :-
625 option(package_directory(PackDir), Options),
626 !.
627pack_install_dir(PackDir, _Options) :- 628 absolute_file_name(pack(.), PackDir,
629 [ file_type(directory),
630 access(write),
631 file_errors(fail)
632 ]),
633 !.
634pack_install_dir(PackDir, Options) :- 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), 650 pack_create_install_dir(Candidates, PackDir, Options).
651
652pack_create_install_dir(Candidates, PackDir, Options) :-
653 Candidates = [Default=_|_],
654 !,
655 append(Candidates, [cancel=cancel], Menu),
656 menu(pack(create_pack_dir), Menu, Default, Selected, Options),
657 Selected \== cancel,
658 ( catch(make_directory_path(Selected), E,
659 (print_message(warning, E), fail))
660 -> PackDir = Selected
661 ; delete(Candidates, PackDir=create_dir(PackDir), Remaining),
662 pack_create_install_dir(Remaining, PackDir, Options)
663 ).
664pack_create_install_dir(_, _, _) :-
665 print_message(error, pack(cannot_create_dir(pack(.)))),
666 fail.
667
668
680
681pack_install(Name, _, Options) :-
682 current_pack(Name),
683 option(upgrade(false), Options, false),
684 print_message(error, pack(already_installed(Name))),
685 pack_info(Name),
686 print_message(information, pack(remove_with(Name))),
687 !,
688 fail.
689pack_install(Name, PackDir, Options) :-
690 option(url(URL), Options),
691 uri_file_name(URL, Source),
692 !,
693 pack_install_from_local(Source, PackDir, Name, Options).
694pack_install(Name, PackDir, Options) :-
695 option(url(URL), Options),
696 uri_components(URL, Components),
697 uri_data(scheme, Components, Scheme),
698 pack_install_from_url(Scheme, URL, PackDir, Name, Options).
699
706
707pack_install_from_local(Source, PackTopDir, Name, Options) :-
708 exists_directory(Source),
709 !,
710 directory_file_path(PackTopDir, Name, PackDir),
711 prepare_pack_dir(PackDir, Options),
712 copy_directory(Source, PackDir),
713 pack_post_install(Name, PackDir, Options).
714pack_install_from_local(Source, PackTopDir, Name, Options) :-
715 exists_file(Source),
716 directory_file_path(PackTopDir, Name, PackDir),
717 prepare_pack_dir(PackDir, Options),
718 pack_unpack(Source, PackDir, Name, Options),
719 pack_post_install(Name, PackDir, Options).
720
721
725
726:- if(current_predicate(archive_extract/3)). 727pack_unpack(Source, PackDir, Pack, Options) :-
728 pack_archive_info(Source, Pack, _Info, StripOptions),
729 prepare_pack_dir(PackDir, Options),
730 archive_extract(Source, PackDir,
731 [ exclude(['._*']) 732 | StripOptions
733 ]).
734:- else. 735pack_unpack(_,_,_,_) :-
736 existence_error(library, archive).
737:- endif. 738
739 742
752
753:- if(current_predicate(archive_open/3)). 754pack_archive_info(Archive, Pack, [archive_size(Bytes)|Info], Strip) :-
755 size_file(Archive, Bytes),
756 setup_call_cleanup(
757 archive_open(Archive, Handle, []),
758 ( repeat,
759 ( archive_next_header(Handle, InfoFile)
760 -> true
761 ; !, fail
762 )
763 ),
764 archive_close(Handle)),
765 file_base_name(InfoFile, 'pack.pl'),
766 atom_concat(Prefix, 'pack.pl', InfoFile),
767 strip_option(Prefix, Pack, Strip),
768 setup_call_cleanup(
769 archive_open_entry(Handle, Stream),
770 read_stream_to_terms(Stream, Info),
771 close(Stream)),
772 !,
773 must_be(ground, Info),
774 maplist(valid_info_term, Info).
775:- else. 776pack_archive_info(_, _, _, _) :-
777 existence_error(library, archive).
778:- endif. 779pack_archive_info(_, _, _, _) :-
780 existence_error(pack_file, 'pack.pl').
781
782strip_option('', _, []) :- !.
783strip_option('./', _, []) :- !.
784strip_option(Prefix, Pack, [remove_prefix(Prefix)]) :-
785 atom_concat(PrefixDir, /, Prefix),
786 file_base_name(PrefixDir, Base),
787 ( Base == Pack
788 -> true
789 ; pack_version_file(Pack, _, Base)
790 -> true
791 ; \+ sub_atom(PrefixDir, _, _, _, /)
792 ).
793
794read_stream_to_terms(Stream, Terms) :-
795 read(Stream, Term0),
796 read_stream_to_terms(Term0, Stream, Terms).
797
798read_stream_to_terms(end_of_file, _, []) :- !.
799read_stream_to_terms(Term0, Stream, [Term0|Terms]) :-
800 read(Stream, Term1),
801 read_stream_to_terms(Term1, Stream, Terms).
802
803
808
809pack_git_info(GitDir, Hash, [git(true), installed_size(Bytes)|Info]) :-
810 exists_directory(GitDir),
811 !,
812 git_ls_tree(Entries, [directory(GitDir)]),
813 git_hash(Hash, [directory(GitDir)]),
814 maplist(arg(4), Entries, Sizes),
815 sum_list(Sizes, Bytes),
816 directory_file_path(GitDir, 'pack.pl', InfoFile),
817 read_file_to_terms(InfoFile, Info, [encoding(utf8)]),
818 must_be(ground, Info),
819 maplist(valid_info_term, Info).
820
824
825download_file_sanity_check(Archive, Pack, Info) :-
826 info_field(name(Name), Info),
827 info_field(version(VersionAtom), Info),
828 atom_version(VersionAtom, Version),
829 pack_version_file(PackA, VersionA, Archive),
830 must_match([Pack, PackA, Name], name),
831 must_match([Version, VersionA], version).
832
833info_field(Field, Info) :-
834 memberchk(Field, Info),
835 ground(Field),
836 !.
837info_field(Field, _Info) :-
838 functor(Field, FieldName, _),
839 print_message(error, pack(missing(FieldName))),
840 fail.
841
842must_match(Values, _Field) :-
843 sort(Values, [_]),
844 !.
845must_match(Values, Field) :-
846 print_message(error, pack(conflict(Field, Values))),
847 fail.
848
849
850 853
859
860prepare_pack_dir(Dir, Options) :-
861 exists_directory(Dir),
862 !,
863 ( empty_directory(Dir)
864 -> true
865 ; option(upgrade(true), Options)
866 -> delete_directory_contents(Dir)
867 ; confirm(remove_existing_pack(Dir), yes, Options),
868 delete_directory_contents(Dir)
869 ).
870prepare_pack_dir(Dir, _) :-
871 make_directory(Dir).
872
876
877empty_directory(Dir) :-
878 \+ ( directory_files(Dir, Entries),
879 member(Entry, Entries),
880 \+ special(Entry)
881 ).
882
883special(.).
884special(..).
885
886
893
894pack_install_from_url(_, URL, PackTopDir, Pack, Options) :-
895 option(git(true), Options),
896 !,
897 directory_file_path(PackTopDir, Pack, PackDir),
898 prepare_pack_dir(PackDir, Options),
899 run_process(path(git), [clone, URL, PackDir], []),
900 pack_git_info(PackDir, Hash, Info),
901 pack_inquiry(URL, git(Hash), Info, Options),
902 show_info(Pack, Info, Options),
903 confirm(git_post_install(PackDir, Pack), yes, Options),
904 pack_post_install(Pack, PackDir, Options).
905pack_install_from_url(Scheme, URL, PackTopDir, Pack, Options) :-
906 download_scheme(Scheme),
907 directory_file_path(PackTopDir, Pack, PackDir),
908 prepare_pack_dir(PackDir, Options),
909 pack_download_dir(PackTopDir, DownLoadDir),
910 download_file(URL, Pack, DownloadBase, Options),
911 directory_file_path(DownLoadDir, DownloadBase, DownloadFile),
912 setup_call_cleanup(
913 http_open(URL, In,
914 [ cert_verify_hook(ssl_verify)
915 ]),
916 setup_call_cleanup(
917 open(DownloadFile, write, Out, [type(binary)]),
918 copy_stream_data(In, Out),
919 close(Out)),
920 close(In)),
921 pack_archive_info(DownloadFile, Pack, Info, _),
922 download_file_sanity_check(DownloadFile, Pack, Info),
923 pack_inquiry(URL, DownloadFile, Info, Options),
924 show_info(Pack, Info, Options),
925 confirm(install_downloaded(DownloadFile), yes, Options),
926 pack_install_from_local(DownloadFile, PackTopDir, Pack, Options).
927
929
930download_file(URL, Pack, File, Options) :-
931 option(version(Version), Options),
932 !,
933 atom_version(VersionA, Version),
934 file_name_extension(_, Ext, URL),
935 format(atom(File), '~w-~w.~w', [Pack, VersionA, Ext]).
936download_file(URL, Pack, File, _) :-
937 file_base_name(URL,Basename),
938 no_int_file_name_extension(Tag,Ext,Basename),
939 tag_version(Tag,Version),
940 !,
941 atom_version(VersionA,Version),
942 format(atom(File0), '~w-~w', [Pack, VersionA]),
943 file_name_extension(File0, Ext, File).
944download_file(URL, _, File, _) :-
945 file_base_name(URL, File).
946
952
953pack_url_file(URL, FileID) :-
954 github_release_url(URL, Pack, Version),
955 !,
956 download_file(URL, Pack, FileID, [version(Version)]).
957pack_url_file(URL, FileID) :-
958 file_base_name(URL, FileID).
959
960
961:- public ssl_verify/5. 962
968
969ssl_verify(_SSL,
970 _ProblemCertificate, _AllCertificates, _FirstCertificate,
971 _Error).
972
973pack_download_dir(PackTopDir, DownLoadDir) :-
974 directory_file_path(PackTopDir, 'Downloads', DownLoadDir),
975 ( exists_directory(DownLoadDir)
976 -> true
977 ; make_directory(DownLoadDir)
978 ),
979 ( access_file(DownLoadDir, write)
980 -> true
981 ; permission_error(write, directory, DownLoadDir)
982 ).
983
987
988download_url(URL) :-
989 atom(URL),
990 uri_components(URL, Components),
991 uri_data(scheme, Components, Scheme),
992 download_scheme(Scheme).
993
994download_scheme(http).
995download_scheme(https) :-
996 catch(use_module(library(http/http_ssl_plugin)),
997 E, (print_message(warning, E), fail)).
998
1006
1007pack_post_install(Pack, PackDir, Options) :-
1008 post_install_foreign(Pack, PackDir,
1009 [ build_foreign(if_absent)
1010 | Options
1011 ]),
1012 post_install_autoload(PackDir, Options),
1013 '$pack_attach'(PackDir).
1014
1018
1019pack_rebuild(Pack) :-
1020 '$pack':pack(Pack, BaseDir),
1021 !,
1022 catch(pack_make(BaseDir, [distclean], []), E,
1023 print_message(warning, E)),
1024 post_install_foreign(Pack, BaseDir, []).
1025pack_rebuild(Pack) :-
1026 existence_error(pack, Pack).
1027
1031
1032pack_rebuild :-
1033 forall(current_pack(Pack),
1034 ( print_message(informational, pack(rebuild(Pack))),
1035 pack_rebuild(Pack)
1036 )).
1037
1038
1042
1043post_install_foreign(Pack, PackDir, Options) :-
1044 is_foreign_pack(PackDir),
1045 !,
1046 ( option(build_foreign(if_absent), Options),
1047 foreign_present(PackDir)
1048 -> print_message(informational, pack(kept_foreign(Pack)))
1049 ; setup_path,
1050 save_build_environment(PackDir),
1051 configure_foreign(PackDir, Options),
1052 make_foreign(PackDir, Options)
1053 ).
1054post_install_foreign(_, _, _).
1055
1056foreign_present(PackDir) :-
1057 current_prolog_flag(arch, Arch),
1058 atomic_list_concat([PackDir, '/lib'], ForeignBaseDir),
1059 exists_directory(ForeignBaseDir),
1060 !,
1061 atomic_list_concat([PackDir, '/lib/', Arch], ForeignDir),
1062 exists_directory(ForeignDir),
1063 current_prolog_flag(shared_object_extension, Ext),
1064 atomic_list_concat([ForeignDir, '/*.', Ext], Pattern),
1065 expand_file_name(Pattern, Files),
1066 Files \== [].
1067
1068is_foreign_pack(PackDir) :-
1069 foreign_file(File),
1070 directory_file_path(PackDir, File, Path),
1071 exists_file(Path),
1072 !.
1073
1074foreign_file('configure.in').
1075foreign_file('configure').
1076foreign_file('Makefile').
1077foreign_file('makefile').
1078
1079
1084
1085configure_foreign(PackDir, Options) :-
1086 make_configure(PackDir, Options),
1087 directory_file_path(PackDir, configure, Configure),
1088 exists_file(Configure),
1089 !,
1090 build_environment(BuildEnv),
1091 run_process(path(bash), [Configure],
1092 [ env(BuildEnv),
1093 directory(PackDir)
1094 ]).
1095configure_foreign(_, _).
1096
1097make_configure(PackDir, _Options) :-
1098 directory_file_path(PackDir, 'configure', Configure),
1099 exists_file(Configure),
1100 !.
1101make_configure(PackDir, _Options) :-
1102 autoconf_master(ConfigMaster),
1103 directory_file_path(PackDir, ConfigMaster, ConfigureIn),
1104 exists_file(ConfigureIn),
1105 !,
1106 run_process(path(autoheader), [], [directory(PackDir)]),
1107 run_process(path(autoconf), [], [directory(PackDir)]).
1108make_configure(_, _).
1109
1110autoconf_master('configure.ac').
1111autoconf_master('configure.in').
1112
1113
1117
1118make_foreign(PackDir, Options) :-
1119 pack_make(PackDir, [all, check, install], Options).
1120
1121pack_make(PackDir, Targets, _Options) :-
1122 directory_file_path(PackDir, 'Makefile', Makefile),
1123 exists_file(Makefile),
1124 !,
1125 build_environment(BuildEnv),
1126 ProcessOptions = [ directory(PackDir), env(BuildEnv) ],
1127 forall(member(Target, Targets),
1128 run_process(path(make), [Target], ProcessOptions)).
1129pack_make(_, _, _).
1130
1135
1136save_build_environment(PackDir) :-
1137 directory_file_path(PackDir, 'buildenv.sh', EnvFile),
1138 build_environment(Env),
1139 setup_call_cleanup(
1140 open(EnvFile, write, Out),
1141 write_env_script(Out, Env),
1142 close(Out)).
1143
1144write_env_script(Out, Env) :-
1145 format(Out,
1146 '# This file contains the environment that can be used to\n\c
1147 # build the foreign pack outside Prolog. This file must\n\c
1148 # be loaded into a bourne-compatible shell using\n\c
1149 #\n\c
1150 # $ source buildenv.sh\n\n',
1151 []),
1152 forall(member(Var=Value, Env),
1153 format(Out, '~w=\'~w\'\n', [Var, Value])),
1154 format(Out, '\nexport ', []),
1155 forall(member(Var=_, Env),
1156 format(Out, ' ~w', [Var])),
1157 format(Out, '\n', []).
1158
1159build_environment(Env) :-
1160 findall(Name=Value, environment(Name, Value), UserEnv),
1161 findall(Name=Value,
1162 ( def_environment(Name, Value),
1163 \+ memberchk(Name=_, UserEnv)
1164 ),
1165 DefEnv),
1166 append(UserEnv, DefEnv, Env).
1167
1168
1186
1187
1192
1193def_environment('PATH', Value) :-
1194 getenv('PATH', PATH),
1195 current_prolog_flag(executable, Exe),
1196 file_directory_name(Exe, ExeDir),
1197 prolog_to_os_filename(ExeDir, OsExeDir),
1198 ( current_prolog_flag(windows, true)
1199 -> Sep = (;)
1200 ; Sep = (:)
1201 ),
1202 atomic_list_concat([OsExeDir, Sep, PATH], Value).
1203def_environment('SWIPL', Value) :-
1204 current_prolog_flag(executable, Value).
1205def_environment('SWIPLVERSION', Value) :-
1206 current_prolog_flag(version, Value).
1207def_environment('SWIHOME', Value) :-
1208 current_prolog_flag(home, Value).
1209def_environment('SWIARCH', Value) :-
1210 current_prolog_flag(arch, Value).
1211def_environment('PACKSODIR', Value) :-
1212 current_prolog_flag(arch, Arch),
1213 atom_concat('lib/', Arch, Value).
1214def_environment('SWISOLIB', Value) :-
1215 current_prolog_flag(c_libplso, Value).
1216def_environment('SWILIB', '-lswipl').
1217def_environment('CC', Value) :-
1218 ( getenv('CC', value)
1219 -> true
1220 ; current_prolog_flag(c_cc, Value)
1221 ).
1222def_environment('LD', Value) :-
1223 ( getenv('LD', Value)
1224 -> true
1225 ; current_prolog_flag(c_cc, Value)
1226 ).
1227def_environment('CFLAGS', Value) :-
1228 ( getenv('CFLAGS', SystemFlags)
1229 -> Extra = [' ', SystemFlags]
1230 ; Extra = []
1231 ),
1232 current_prolog_flag(c_cflags, Value0),
1233 current_prolog_flag(home, Home),
1234 atomic_list_concat([Value0, ' -I"', Home, '/include"' | Extra], Value).
1235def_environment('LDSOFLAGS', Value) :-
1236 ( getenv('LDFLAGS', SystemFlags)
1237 -> Extra = [' ', SystemFlags|System]
1238 ; Extra = System
1239 ),
1240 ( current_prolog_flag(windows, true)
1241 -> current_prolog_flag(home, Home),
1242 atomic_list_concat([' -L"', Home, '/bin"'], SystemLib),
1243 System = [SystemLib]
1244 ; current_prolog_flag(shared_object_extension, so)
1245 -> System = [] 1246 ; current_prolog_flag(home, Home),
1247 current_prolog_flag(arch, Arch),
1248 atomic_list_concat([' -L"', Home, '/lib/', Arch, '"'], SystemLib),
1249 System = [SystemLib]
1250 ),
1251 current_prolog_flag(c_ldflags, LDFlags),
1252 atomic_list_concat([LDFlags, ' -shared' | Extra], Value).
1253def_environment('SOEXT', Value) :-
1254 current_prolog_flag(shared_object_extension, Value).
1255def_environment(Pass, Value) :-
1256 pass_env(Pass),
1257 getenv(Pass, Value).
1258
1259pass_env('TMP').
1260pass_env('TEMP').
1261pass_env('USER').
1262pass_env('HOME').
1263
1264 1267
1268setup_path :-
1269 has_program(path(make), _),
1270 has_program(path(gcc), _),
1271 !.
1272setup_path :-
1273 current_prolog_flag(windows, true),
1274 !,
1275 ( mingw_extend_path
1276 -> true
1277 ; print_message(error, pack(no_mingw))
1278 ).
1279setup_path.
1280
1281has_program(Program, Path) :-
1282 exe_options(ExeOptions),
1283 absolute_file_name(Program, Path,
1284 [ file_errors(fail)
1285 | ExeOptions
1286 ]).
1287
1288exe_options(Options) :-
1289 current_prolog_flag(windows, true),
1290 !,
1291 Options = [ extensions(['',exe,com]), access(read) ].
1292exe_options(Options) :-
1293 Options = [ access(execute) ].
1294
1295mingw_extend_path :-
1296 mingw_root(MinGW),
1297 directory_file_path(MinGW, bin, MinGWBinDir),
1298 atom_concat(MinGW, '/msys/*/bin', Pattern),
1299 expand_file_name(Pattern, MsysDirs),
1300 last(MsysDirs, MSysBinDir),
1301 prolog_to_os_filename(MinGWBinDir, WinDirMinGW),
1302 prolog_to_os_filename(MSysBinDir, WinDirMSYS),
1303 getenv('PATH', Path0),
1304 atomic_list_concat([WinDirMSYS, WinDirMinGW, Path0], ';', Path),
1305 setenv('PATH', Path).
1306
1307mingw_root(MinGwRoot) :-
1308 current_prolog_flag(executable, Exe),
1309 sub_atom(Exe, 1, _, _, :),
1310 sub_atom(Exe, 0, 1, _, PlDrive),
1311 Drives = [PlDrive,c,d],
1312 member(Drive, Drives),
1313 format(atom(MinGwRoot), '~a:/MinGW', [Drive]),
1314 exists_directory(MinGwRoot),
1315 !.
1316
1317
1318 1321
1325
1326post_install_autoload(PackDir, Options) :-
1327 option(autoload(true), Options, true),
1328 pack_info_term(PackDir, autoload(true)),
1329 !,
1330 directory_file_path(PackDir, prolog, PrologLibDir),
1331 make_library_index(PrologLibDir).
1332post_install_autoload(_, _).
1333
1334
1335 1338
1344
1345pack_upgrade(Pack) :-
1346 pack_info(Pack, _, directory(Dir)),
1347 directory_file_path(Dir, '.git', GitDir),
1348 exists_directory(GitDir),
1349 !,
1350 print_message(informational, pack(git_fetch(Dir))),
1351 git([fetch], [ directory(Dir) ]),
1352 git_describe(V0, [ directory(Dir) ]),
1353 git_describe(V1, [ directory(Dir), commit('origin/master') ]),
1354 ( V0 == V1
1355 -> print_message(informational, pack(up_to_date(Pack)))
1356 ; confirm(upgrade(Pack, V0, V1), yes, []),
1357 git([merge, 'origin/master'], [ directory(Dir) ]),
1358 pack_rebuild(Pack)
1359 ).
1360pack_upgrade(Pack) :-
1361 once(pack_info(Pack, _, version(VersionAtom))),
1362 atom_version(VersionAtom, Version),
1363 pack_info(Pack, _, download(URL)),
1364 ( wildcard_pattern(URL)
1365 -> true
1366 ; github_url(URL, _User, _Repo)
1367 ),
1368 !,
1369 available_download_versions(URL, [Latest-LatestURL|_Versions]),
1370 ( Latest @> Version
1371 -> confirm(upgrade(Pack, Version, Latest), yes, []),
1372 pack_install(Pack,
1373 [ url(LatestURL),
1374 upgrade(true),
1375 pack(Pack)
1376 ])
1377 ; print_message(informational, pack(up_to_date(Pack)))
1378 ).
1379pack_upgrade(Pack) :-
1380 print_message(warning, pack(no_upgrade_info(Pack))).
1381
1382
1383 1386
1390
1391pack_remove(Pack) :-
1392 update_dependency_db,
1393 ( setof(Dep, pack_depends_on(Dep, Pack), Deps)
1394 -> confirm_remove(Pack, Deps, Delete),
1395 forall(member(P, Delete), pack_remove_forced(P))
1396 ; pack_remove_forced(Pack)
1397 ).
1398
1399pack_remove_forced(Pack) :-
1400 '$pack_detach'(Pack, BaseDir),
1401 print_message(informational, pack(remove(BaseDir))),
1402 delete_directory_and_contents(BaseDir).
1403
1404confirm_remove(Pack, Deps, Delete) :-
1405 print_message(warning, pack(depends(Pack, Deps))),
1406 menu(pack(resolve_remove),
1407 [ [Pack] = remove_only(Pack),
1408 [Pack|Deps] = remove_deps(Pack, Deps),
1409 [] = cancel
1410 ], [], Delete, []),
1411 Delete \== [].
1412
1413
1414 1417
1438
1439pack_property(Pack, Property) :-
1440 findall(Pack-Property, pack_property_(Pack, Property), List),
1441 member(Pack-Property, List). 1442
1443pack_property_(Pack, Property) :-
1444 pack_info(Pack, _, Property).
1445pack_property_(Pack, Property) :-
1446 \+ \+ info_file(Property, _),
1447 '$pack':pack(Pack, BaseDir),
1448 access_file(BaseDir, read),
1449 directory_files(BaseDir, Files),
1450 member(File, Files),
1451 info_file(Property, Pattern),
1452 downcase_atom(File, Pattern),
1453 directory_file_path(BaseDir, File, InfoFile),
1454 arg(1, Property, InfoFile).
1455
1456info_file(readme(_), 'readme.txt').
1457info_file(readme(_), 'readme').
1458info_file(todo(_), 'todo.txt').
1459info_file(todo(_), 'todo').
1460
1461
1462 1465
1469
1470git_url(URL, Pack) :-
1471 uri_components(URL, Components),
1472 uri_data(scheme, Components, Scheme),
1473 uri_data(path, Components, Path),
1474 ( Scheme == git
1475 -> true
1476 ; git_download_scheme(Scheme),
1477 file_name_extension(_, git, Path)
1478 ),
1479 file_base_name(Path, PackExt),
1480 ( file_name_extension(Pack, git, PackExt)
1481 -> true
1482 ; Pack = PackExt
1483 ),
1484 ( safe_pack_name(Pack)
1485 -> true
1486 ; domain_error(pack_name, Pack)
1487 ).
1488
1489git_download_scheme(http).
1490git_download_scheme(https).
1491
1496
1497safe_pack_name(Name) :-
1498 atom_length(Name, Len),
1499 Len >= 3, 1500 atom_codes(Name, Codes),
1501 maplist(safe_pack_char, Codes),
1502 !.
1503
1504safe_pack_char(C) :- between(0'a, 0'z, C), !.
1505safe_pack_char(C) :- between(0'A, 0'Z, C), !.
1506safe_pack_char(C) :- between(0'0, 0'9, C), !.
1507safe_pack_char(0'_).
1508
1509
1510 1513
1520
1521pack_version_file(Pack, Version, GitHubRelease) :-
1522 atomic(GitHubRelease),
1523 github_release_url(GitHubRelease, Pack, Version),
1524 !.
1525pack_version_file(Pack, Version, Path) :-
1526 atomic(Path),
1527 file_base_name(Path, File),
1528 no_int_file_name_extension(Base, _Ext, File),
1529 atom_codes(Base, Codes),
1530 ( phrase(pack_version(Pack, Version), Codes),
1531 safe_pack_name(Pack)
1532 -> true
1533 ).
1534
1535no_int_file_name_extension(Base, Ext, File) :-
1536 file_name_extension(Base0, Ext0, File),
1537 \+ atom_number(Ext0, _),
1538 !,
1539 Base = Base0,
1540 Ext = Ext0.
1541no_int_file_name_extension(File, '', File).
1542
1543
1544
1553
1554github_release_url(URL, Pack, Version) :-
1555 uri_components(URL, Components),
1556 uri_data(authority, Components, 'github.com'),
1557 uri_data(scheme, Components, Scheme),
1558 download_scheme(Scheme),
1559 uri_data(path, Components, Path),
1560 atomic_list_concat(['',_Project,Pack,archive,File], /, Path),
1561 file_name_extension(Tag, Ext, File),
1562 github_archive_extension(Ext),
1563 tag_version(Tag, Version),
1564 !.
1565
1566github_archive_extension(tgz).
1567github_archive_extension(zip).
1568
1569tag_version(Tag, Version) :-
1570 version_tag_prefix(Prefix),
1571 atom_concat(Prefix, AtomVersion, Tag),
1572 atom_version(AtomVersion, Version).
1573
1574version_tag_prefix(v).
1575version_tag_prefix('V').
1576version_tag_prefix('').
1577
1578
1579:- public
1580 atom_version/2. 1581
1587
1588atom_version(Atom, version(Parts)) :-
1589 ( atom(Atom)
1590 -> atom_codes(Atom, Codes),
1591 phrase(version(Parts), Codes)
1592 ; atomic_list_concat(Parts, '.', Atom)
1593 ).
1594
1595pack_version(Pack, version(Parts)) -->
1596 string(Codes), "-",
1597 version(Parts),
1598 !,
1599 { atom_codes(Pack, Codes)
1600 }.
1601
1602version([_|T]) -->
1603 "*",
1604 !,
1605 ( "."
1606 -> version(T)
1607 ; []
1608 ).
1609version([H|T]) -->
1610 integer(H),
1611 ( "."
1612 -> version(T)
1613 ; { T = [] }
1614 ).
1615
1616integer(H) --> digit(D0), digits(L), { number_codes(H, [D0|L]) }.
1617digit(D) --> [D], { code_type(D, digit) }.
1618digits([H|T]) --> digit(H), !, digits(T).
1619digits([]) --> [].
1620
1621
1622 1625
1643
1644pack_inquiry(_, _, _, Options) :-
1645 option(inquiry(false), Options),
1646 !.
1647pack_inquiry(URL, DownloadFile, Info, Options) :-
1648 setting(server, ServerBase),
1649 ServerBase \== '',
1650 atom_concat(ServerBase, query, Server),
1651 ( option(inquiry(true), Options)
1652 -> true
1653 ; confirm(inquiry(Server), yes, Options)
1654 ),
1655 !,
1656 ( DownloadFile = git(SHA1)
1657 -> true
1658 ; file_sha1(DownloadFile, SHA1)
1659 ),
1660 query_pack_server(install(URL, SHA1, Info), Reply, Options),
1661 inquiry_result(Reply, URL, Options).
1662pack_inquiry(_, _, _, _).
1663
1664
1669
1670query_pack_server(Query, Result, Options) :-
1671 setting(server, ServerBase),
1672 ServerBase \== '',
1673 atom_concat(ServerBase, query, Server),
1674 format(codes(Data), '~q.~n', Query),
1675 info_level(Informational, Options),
1676 print_message(Informational, pack(contacting_server(Server))),
1677 setup_call_cleanup(
1678 http_open(Server, In,
1679 [ post(codes(application/'x-prolog', Data)),
1680 header(content_type, ContentType)
1681 ]),
1682 read_reply(ContentType, In, Result),
1683 close(In)),
1684 message_severity(Result, Level, Informational),
1685 print_message(Level, pack(server_reply(Result))).
1686
1687read_reply(ContentType, In, Result) :-
1688 sub_atom(ContentType, 0, _, _, 'application/x-prolog'),
1689 !,
1690 set_stream(In, encoding(utf8)),
1691 read(In, Result).
1692read_reply(ContentType, In, _Result) :-
1693 read_string(In, 500, String),
1694 print_message(error, pack(no_prolog_response(ContentType, String))),
1695 fail.
1696
1697info_level(Level, Options) :-
1698 option(silent(true), Options),
1699 !,
1700 Level = silent.
1701info_level(informational, _).
1702
1703message_severity(true(_), Informational, Informational).
1704message_severity(false, warning, _).
1705message_severity(exception(_), error, _).
1706
1707
1712
1713inquiry_result(Reply, File, Options) :-
1714 findall(Eval, eval_inquiry(Reply, File, Eval, Options), Evaluation),
1715 \+ member(cancel, Evaluation),
1716 select_option(git(_), Options, Options1, _),
1717 forall(member(install_dependencies(Resolution), Evaluation),
1718 maplist(install_dependency(Options1), Resolution)).
1719
1720eval_inquiry(true(Reply), URL, Eval, _) :-
1721 include(alt_hash, Reply, Alts),
1722 Alts \== [],
1723 print_message(warning, pack(alt_hashes(URL, Alts))),
1724 ( memberchk(downloads(Count), Reply),
1725 ( git_url(URL, _)
1726 -> Default = yes,
1727 Eval = with_git_commits_in_same_version
1728 ; Default = no,
1729 Eval = with_alt_hashes
1730 ),
1731 confirm(continue_with_alt_hashes(Count, URL), Default, [])
1732 -> true
1733 ; !, 1734 Eval = cancel
1735 ).
1736eval_inquiry(true(Reply), _, Eval, Options) :-
1737 include(dependency, Reply, Deps),
1738 Deps \== [],
1739 select_dependency_resolution(Deps, Eval, Options),
1740 ( Eval == cancel
1741 -> !
1742 ; true
1743 ).
1744eval_inquiry(true(Reply), URL, true, Options) :-
1745 file_base_name(URL, File),
1746 info_level(Informational, Options),
1747 print_message(Informational, pack(inquiry_ok(Reply, File))).
1748eval_inquiry(exception(pack(modified_hash(_SHA1-URL, _SHA2-[URL]))),
1749 URL, Eval, Options) :-
1750 ( confirm(continue_with_modified_hash(URL), no, Options)
1751 -> Eval = true
1752 ; Eval = cancel
1753 ).
1754
1755alt_hash(alt_hash(_,_,_)).
1756dependency(dependency(_,_,_,_,_)).
1757
1758
1764
1765select_dependency_resolution(Deps, Eval, Options) :-
1766 resolve_dependencies(Deps, Resolution),
1767 exclude(local_dep, Resolution, ToBeDone),
1768 ( ToBeDone == []
1769 -> !, Eval = true
1770 ; print_message(warning, pack(install_dependencies(Resolution))),
1771 ( memberchk(_-unresolved, Resolution)
1772 -> Default = cancel
1773 ; Default = install_deps
1774 ),
1775 menu(pack(resolve_deps),
1776 [ install_deps = install_deps,
1777 install_no_deps = install_no_deps,
1778 cancel = cancel
1779 ], Default, Choice, Options),
1780 ( Choice == cancel
1781 -> !, Eval = cancel
1782 ; Choice == install_no_deps
1783 -> !, Eval = install_no_deps
1784 ; !, Eval = install_dependencies(Resolution)
1785 )
1786 ).
1787
1788local_dep(_-resolved(_)).
1789
1790
1796
1797install_dependency(Options,
1798 _Token-resolve(Pack, VersionAtom, [_URL|_], SubResolve)) :-
1799 atom_version(VersionAtom, Version),
1800 current_pack(Pack),
1801 pack_info(Pack, _, version(InstalledAtom)),
1802 atom_version(InstalledAtom, Installed),
1803 Installed == Version, 1804 !,
1805 maplist(install_dependency(Options), SubResolve).
1806install_dependency(Options,
1807 _Token-resolve(Pack, VersionAtom, [URL|_], SubResolve)) :-
1808 !,
1809 atom_version(VersionAtom, Version),
1810 merge_options([ url(URL),
1811 version(Version),
1812 interactive(false),
1813 inquiry(false),
1814 info(list),
1815 pack(Pack)
1816 ], Options, InstallOptions),
1817 pack_install(Pack, InstallOptions),
1818 maplist(install_dependency(Options), SubResolve).
1819install_dependency(_, _-_).
1820
1821
1822 1825
1832
1833available_download_versions(URL, Versions) :-
1834 wildcard_pattern(URL),
1835 github_url(URL, User, Repo),
1836 !,
1837 findall(Version-VersionURL,
1838 github_version(User, Repo, Version, VersionURL),
1839 Versions).
1840available_download_versions(URL, Versions) :-
1841 wildcard_pattern(URL),
1842 !,
1843 file_directory_name(URL, DirURL0),
1844 ensure_slash(DirURL0, DirURL),
1845 print_message(informational, pack(query_versions(DirURL))),
1846 setup_call_cleanup(
1847 http_open(DirURL, In, []),
1848 load_html(stream(In), DOM,
1849 [ syntax_errors(quiet)
1850 ]),
1851 close(In)),
1852 findall(MatchingURL,
1853 absolute_matching_href(DOM, URL, MatchingURL),
1854 MatchingURLs),
1855 ( MatchingURLs == []
1856 -> print_message(warning, pack(no_matching_urls(URL)))
1857 ; true
1858 ),
1859 versioned_urls(MatchingURLs, VersionedURLs),
1860 keysort(VersionedURLs, SortedVersions),
1861 reverse(SortedVersions, Versions),
1862 print_message(informational, pack(found_versions(Versions))).
1863available_download_versions(URL, [Version-URL]) :-
1864 ( pack_version_file(_Pack, Version0, URL)
1865 -> Version = Version0
1866 ; Version = unknown
1867 ).
1868
1872
1873github_url(URL, User, Repo) :-
1874 uri_components(URL, uri_components(https,'github.com',Path,_,_)),
1875 atomic_list_concat(['',User,Repo|_], /, Path).
1876
1877
1882
1883github_version(User, Repo, Version, VersionURI) :-
1884 atomic_list_concat(['',repos,User,Repo,tags], /, Path1),
1885 uri_components(ApiUri, uri_components(https,'api.github.com',Path1,_,_)),
1886 setup_call_cleanup(
1887 http_open(ApiUri, In,
1888 [ request_header('Accept'='application/vnd.github.v3+json')
1889 ]),
1890 json_read_dict(In, Dicts),
1891 close(In)),
1892 member(Dict, Dicts),
1893 atom_string(Tag, Dict.name),
1894 tag_version(Tag, Version),
1895 atom_string(VersionURI, Dict.zipball_url).
1896
1897wildcard_pattern(URL) :- sub_atom(URL, _, _, _, *).
1898wildcard_pattern(URL) :- sub_atom(URL, _, _, _, ?).
1899
1900ensure_slash(Dir, DirS) :-
1901 ( sub_atom(Dir, _, _, 0, /)
1902 -> DirS = Dir
1903 ; atom_concat(Dir, /, DirS)
1904 ).
1905
1906absolute_matching_href(DOM, Pattern, Match) :-
1907 xpath(DOM, //a(@href), HREF),
1908 uri_normalized(HREF, Pattern, Match),
1909 wildcard_match(Pattern, Match).
1910
1911versioned_urls([], []).
1912versioned_urls([H|T0], List) :-
1913 file_base_name(H, File),
1914 ( pack_version_file(_Pack, Version, File)
1915 -> List = [Version-H|T]
1916 ; List = T
1917 ),
1918 versioned_urls(T0, T).
1919
1920
1921 1924
1928
1929update_dependency_db :-
1930 retractall(pack_requires(_,_)),
1931 retractall(pack_provides_db(_,_)),
1932 forall(current_pack(Pack),
1933 ( findall(Info, pack_info(Pack, dependency, Info), Infos),
1934 update_dependency_db(Pack, Infos)
1935 )).
1936
1937update_dependency_db(Name, Info) :-
1938 retractall(pack_requires(Name, _)),
1939 retractall(pack_provides_db(Name, _)),
1940 maplist(assert_dep(Name), Info).
1941
1942assert_dep(Pack, provides(Token)) :-
1943 !,
1944 assertz(pack_provides_db(Pack, Token)).
1945assert_dep(Pack, requires(Token)) :-
1946 !,
1947 assertz(pack_requires(Pack, Token)).
1948assert_dep(_, _).
1949
1953
1954validate_dependencies :-
1955 unsatisfied_dependencies(Unsatisfied),
1956 !,
1957 print_message(warning, pack(unsatisfied(Unsatisfied))).
1958validate_dependencies.
1959
1960
1961unsatisfied_dependencies(Unsatisfied) :-
1962 findall(Req-Pack, pack_requires(Pack, Req), Reqs0),
1963 keysort(Reqs0, Reqs1),
1964 group_pairs_by_key(Reqs1, GroupedReqs),
1965 exclude(satisfied_dependency, GroupedReqs, Unsatisfied),
1966 Unsatisfied \== [].
1967
1968satisfied_dependency(Needed-_By) :-
1969 pack_provides(_, Needed),
1970 !.
1971satisfied_dependency(Needed-_By) :-
1972 compound(Needed),
1973 Needed =.. [Op, Pack, ReqVersion],
1974 ( pack_provides(Pack, Pack)
1975 -> pack_info(Pack, _, version(PackVersion)),
1976 version_data(PackVersion, PackData)
1977 ; Pack == prolog
1978 -> current_prolog_flag(version_data, swi(Major,Minor,Patch,_)),
1979 PackData = [Major,Minor,Patch]
1980 ),
1981 version_data(ReqVersion, ReqData),
1982 cmp(Op, Cmp),
1983 call(Cmp, PackData, ReqData).
1984
1988
1989pack_provides(Pack, Pack) :-
1990 current_pack(Pack).
1991pack_provides(Pack, Token) :-
1992 pack_provides_db(Pack, Token).
1993
1997
1998pack_depends_on(Pack, Dependency) :-
1999 ( atom(Pack)
2000 -> pack_depends_on_fwd(Pack, Dependency, [Pack])
2001 ; pack_depends_on_bwd(Pack, Dependency, [Dependency])
2002 ).
2003
2004pack_depends_on_fwd(Pack, Dependency, Visited) :-
2005 pack_depends_on_1(Pack, Dep1),
2006 \+ memberchk(Dep1, Visited),
2007 ( Dependency = Dep1
2008 ; pack_depends_on_fwd(Dep1, Dependency, [Dep1|Visited])
2009 ).
2010
2011pack_depends_on_bwd(Pack, Dependency, Visited) :-
2012 pack_depends_on_1(Dep1, Dependency),
2013 \+ memberchk(Dep1, Visited),
2014 ( Pack = Dep1
2015 ; pack_depends_on_bwd(Pack, Dep1, [Dep1|Visited])
2016 ).
2017
2018pack_depends_on_1(Pack, Dependency) :-
2019 atom(Dependency),
2020 !,
2021 pack_provides(Dependency, Token),
2022 pack_requires(Pack, Token).
2023pack_depends_on_1(Pack, Dependency) :-
2024 pack_requires(Pack, Token),
2025 pack_provides(Dependency, Token).
2026
2027
2041
2042resolve_dependencies(Dependencies, Resolution) :-
2043 maplist(dependency_pair, Dependencies, Pairs0),
2044 keysort(Pairs0, Pairs1),
2045 group_pairs_by_key(Pairs1, ByToken),
2046 maplist(resolve_dep, ByToken, Resolution).
2047
2048dependency_pair(dependency(Token, Pack, Version, URLs, SubDeps),
2049 Token-(Pack-pack(Version,URLs, SubDeps))).
2050
2051resolve_dep(Token-Pairs, Token-Resolution) :-
2052 ( resolve_dep2(Token-Pairs, Resolution)
2053 *-> true
2054 ; Resolution = unresolved
2055 ).
2056
2057resolve_dep2(Token-_, resolved(Pack)) :-
2058 pack_provides(Pack, Token).
2059resolve_dep2(_-Pairs, resolve(Pack, VersionAtom, URLs, SubResolves)) :-
2060 keysort(Pairs, Sorted),
2061 group_pairs_by_key(Sorted, ByPack),
2062 member(Pack-Versions, ByPack),
2063 Pack \== (-),
2064 maplist(version_pack, Versions, VersionData),
2065 sort(VersionData, ByVersion),
2066 reverse(ByVersion, ByVersionLatest),
2067 member(pack(Version,URLs,SubDeps), ByVersionLatest),
2068 atom_version(VersionAtom, Version),
2069 include(dependency, SubDeps, Deps),
2070 resolve_dependencies(Deps, SubResolves).
2071
2072version_pack(pack(VersionAtom,URLs,SubDeps),
2073 pack(Version,URLs,SubDeps)) :-
2074 atom_version(VersionAtom, Version).
2075
2076
2077 2080
2095
2096run_process(Executable, Argv, Options) :-
2097 \+ option(output(_), Options),
2098 \+ option(error(_), Options),
2099 current_prolog_flag(unix, true),
2100 current_prolog_flag(threads, true),
2101 !,
2102 process_create_options(Options, Extra),
2103 process_create(Executable, Argv,
2104 [ stdout(pipe(Out)),
2105 stderr(pipe(Error)),
2106 process(PID)
2107 | Extra
2108 ]),
2109 thread_create(relay_output([output-Out, error-Error]), Id, []),
2110 process_wait(PID, Status),
2111 thread_join(Id, _),
2112 ( Status == exit(0)
2113 -> true
2114 ; throw(error(process_error(process(Executable, Argv), Status), _))
2115 ).
2116run_process(Executable, Argv, Options) :-
2117 process_create_options(Options, Extra),
2118 setup_call_cleanup(
2119 process_create(Executable, Argv,
2120 [ stdout(pipe(Out)),
2121 stderr(pipe(Error)),
2122 process(PID)
2123 | Extra
2124 ]),
2125 ( read_stream_to_codes(Out, OutCodes, []),
2126 read_stream_to_codes(Error, ErrorCodes, []),
2127 process_wait(PID, Status)
2128 ),
2129 ( close(Out),
2130 close(Error)
2131 )),
2132 print_error(ErrorCodes, Options),
2133 print_output(OutCodes, Options),
2134 ( Status == exit(0)
2135 -> true
2136 ; throw(error(process_error(process(Executable, Argv), Status), _))
2137 ).
2138
2139process_create_options(Options, Extra) :-
2140 option(directory(Dir), Options, .),
2141 ( option(env(Env), Options)
2142 -> Extra = [cwd(Dir), env(Env)]
2143 ; Extra = [cwd(Dir)]
2144 ).
2145
2146relay_output([]) :- !.
2147relay_output(Output) :-
2148 pairs_values(Output, Streams),
2149 wait_for_input(Streams, Ready, infinite),
2150 relay(Ready, Output, NewOutputs),
2151 relay_output(NewOutputs).
2152
2153relay([], Outputs, Outputs).
2154relay([H|T], Outputs0, Outputs) :-
2155 selectchk(Type-H, Outputs0, Outputs1),
2156 ( at_end_of_stream(H)
2157 -> close(H),
2158 relay(T, Outputs1, Outputs)
2159 ; read_pending_codes(H, Codes, []),
2160 relay(Type, Codes),
2161 relay(T, Outputs0, Outputs)
2162 ).
2163
2164relay(error, Codes) :-
2165 set_prolog_flag(thread_message_prefix, false),
2166 print_error(Codes, []).
2167relay(output, Codes) :-
2168 print_output(Codes, []).
2169
2170print_output(OutCodes, Options) :-
2171 option(output(Codes), Options),
2172 !,
2173 Codes = OutCodes.
2174print_output(OutCodes, _) :-
2175 print_message(informational, pack(process_output(OutCodes))).
2176
2177print_error(OutCodes, Options) :-
2178 option(error(Codes), Options),
2179 !,
2180 Codes = OutCodes.
2181print_error(OutCodes, _) :-
2182 phrase(classify_message(Level), OutCodes, _),
2183 print_message(Level, pack(process_output(OutCodes))).
2184
2185classify_message(error) -->
2186 string(_), "fatal:",
2187 !.
2188classify_message(error) -->
2189 string(_), "error:",
2190 !.
2191classify_message(warning) -->
2192 string(_), "warning:",
2193 !.
2194classify_message(informational) -->
2195 [].
2196
2197string([]) --> [].
2198string([H|T]) --> [H], string(T).
2199
2200
2201 2204
2205:- multifile prolog:message//1. 2206
2208
(_Question, _Alternatives, Default, Selection, Options) :-
2210 option(interactive(false), Options),
2211 !,
2212 Selection = Default.
2213menu(Question, Alternatives, Default, Selection, _) :-
2214 length(Alternatives, N),
2215 between(1, 5, _),
2216 print_message(query, Question),
2217 print_menu(Alternatives, Default, 1),
2218 print_message(query, pack(menu(select))),
2219 read_selection(N, Choice),
2220 !,
2221 ( Choice == default
2222 -> Selection = Default
2223 ; nth1(Choice, Alternatives, Selection=_)
2224 -> true
2225 ).
2226
([], _, _).
2228print_menu([Value=Label|T], Default, I) :-
2229 ( Value == Default
2230 -> print_message(query, pack(menu(default_item(I, Label))))
2231 ; print_message(query, pack(menu(item(I, Label))))
2232 ),
2233 I2 is I + 1,
2234 print_menu(T, Default, I2).
2235
2236read_selection(Max, Choice) :-
2237 get_single_char(Code),
2238 ( answered_default(Code)
2239 -> Choice = default
2240 ; code_type(Code, digit(Choice)),
2241 between(1, Max, Choice)
2242 -> true
2243 ; print_message(warning, pack(menu(reply(1,Max)))),
2244 fail
2245 ).
2246
2252
2253confirm(_Question, Default, Options) :-
2254 Default \== none,
2255 option(interactive(false), Options, true),
2256 !,
2257 Default == yes.
2258confirm(Question, Default, _) :-
2259 between(1, 5, _),
2260 print_message(query, pack(confirm(Question, Default))),
2261 read_yes_no(YesNo, Default),
2262 !,
2263 format(user_error, '~N', []),
2264 YesNo == yes.
2265
2266read_yes_no(YesNo, Default) :-
2267 get_single_char(Code),
2268 code_yes_no(Code, Default, YesNo),
2269 !.
2270
2271code_yes_no(0'y, _, yes).
2272code_yes_no(0'Y, _, yes).
2273code_yes_no(0'n, _, no).
2274code_yes_no(0'N, _, no).
2275code_yes_no(_, none, _) :- !, fail.
2276code_yes_no(C, Default, Default) :-
2277 answered_default(C).
2278
2279answered_default(0'\r).
2280answered_default(0'\n).
2281answered_default(0'\s).
2282
2283
2284 2287
2288:- multifile prolog:message//1. 2289
2290prolog:message(pack(Message)) -->
2291 message(Message).
2292
2293:- discontiguous
2294 message//1,
2295 label//1. 2296
2297message(invalid_info(Term)) -->
2298 [ 'Invalid package description: ~q'-[Term] ].
2299message(directory_exists(Dir)) -->
2300 [ 'Package target directory exists and is not empty:', nl,
2301 '\t~q'-[Dir]
2302 ].
2303message(already_installed(pack(Pack, Version))) -->
2304 { atom_version(AVersion, Version) },
2305 [ 'Pack `~w'' is already installed @~w'-[Pack, AVersion] ].
2306message(already_installed(Pack)) -->
2307 [ 'Pack `~w'' is already installed. Package info:'-[Pack] ].
2308message(invalid_name(File)) -->
2309 [ '~w: A package archive must be named <pack>-<version>.<ext>'-[File] ],
2310 no_tar_gz(File).
2311
2312no_tar_gz(File) -->
2313 { sub_atom(File, _, _, 0, '.tar.gz') },
2314 !,
2315 [ nl,
2316 'Package archive files must have a single extension. E.g., \'.tgz\''-[]
2317 ].
2318no_tar_gz(_) --> [].
2319
2320message(kept_foreign(Pack)) -->
2321 [ 'Found foreign libraries for target platform.'-[], nl,
2322 'Use ?- pack_rebuild(~q). to rebuild from sources'-[Pack]
2323 ].
2324message(no_pack_installed(Pack)) -->
2325 [ 'No pack ~q installed. Use ?- pack_list(Pattern) to search'-[Pack] ].
2326message(no_packages_installed) -->
2327 { setting(server, ServerBase) },
2328 [ 'There are no extra packages installed.', nl,
2329 'Please visit ~wlist.'-[ServerBase]
2330 ].
2331message(remove_with(Pack)) -->
2332 [ 'The package can be removed using: ?- ~q.'-[pack_remove(Pack)]
2333 ].
2334message(unsatisfied(Packs)) -->
2335 [ 'The following dependencies are not satisfied:', nl ],
2336 unsatisfied(Packs).
2337message(depends(Pack, Deps)) -->
2338 [ 'The following packages depend on `~w\':'-[Pack], nl ],
2339 pack_list(Deps).
2340message(remove(PackDir)) -->
2341 [ 'Removing ~q and contents'-[PackDir] ].
2342message(remove_existing_pack(PackDir)) -->
2343 [ 'Remove old installation in ~q'-[PackDir] ].
2344message(install_from(Pack, Version, git(URL))) -->
2345 [ 'Install ~w@~w from GIT at ~w'-[Pack, Version, URL] ].
2346message(install_from(Pack, Version, URL)) -->
2347 [ 'Install ~w@~w from ~w'-[Pack, Version, URL] ].
2348message(select_install_from(Pack, Version)) -->
2349 [ 'Select download location for ~w@~w'-[Pack, Version] ].
2350message(install_downloaded(File)) -->
2351 { file_base_name(File, Base),
2352 size_file(File, Size) },
2353 [ 'Install "~w" (~D bytes)'-[Base, Size] ].
2354message(git_post_install(PackDir, Pack)) -->
2355 ( { is_foreign_pack(PackDir) }
2356 -> [ 'Run post installation scripts for pack "~w"'-[Pack] ]
2357 ; [ 'Activate pack "~w"'-[Pack] ]
2358 ).
2359message(no_meta_data(BaseDir)) -->
2360 [ 'Cannot find pack.pl inside directory ~q. Not a package?'-[BaseDir] ].
2361message(inquiry(Server)) -->
2362 [ 'Verify package status (anonymously)', nl,
2363 '\tat "~w"'-[Server]
2364 ].
2365message(search_no_matches(Name)) -->
2366 [ 'Search for "~w", returned no matching packages'-[Name] ].
2367message(rebuild(Pack)) -->
2368 [ 'Checking pack "~w" for rebuild ...'-[Pack] ].
2369message(upgrade(Pack, From, To)) -->
2370 [ 'Upgrade "~w" from '-[Pack] ],
2371 msg_version(From), [' to '-[]], msg_version(To).
2372message(up_to_date(Pack)) -->
2373 [ 'Package "~w" is up-to-date'-[Pack] ].
2374message(query_versions(URL)) -->
2375 [ 'Querying "~w" to find new versions ...'-[URL] ].
2376message(no_matching_urls(URL)) -->
2377 [ 'Could not find any matching URL: ~q'-[URL] ].
2378message(found_versions([Latest-_URL|More])) -->
2379 { length(More, Len),
2380 atom_version(VLatest, Latest)
2381 },
2382 [ ' Latest version: ~w (~D older)'-[VLatest, Len] ].
2383message(process_output(Codes)) -->
2384 { split_lines(Codes, Lines) },
2385 process_lines(Lines).
2386message(contacting_server(Server)) -->
2387 [ 'Contacting server at ~w ...'-[Server], flush ].
2388message(server_reply(true(_))) -->
2389 [ at_same_line, ' ok'-[] ].
2390message(server_reply(false)) -->
2391 [ at_same_line, ' done'-[] ].
2392message(server_reply(exception(E))) -->
2393 [ 'Server reported the following error:'-[], nl ],
2394 '$messages':translate_message(E).
2395message(cannot_create_dir(Alias)) -->
2396 { setof(PackDir,
2397 absolute_file_name(Alias, PackDir, [solutions(all)]),
2398 PackDirs)
2399 },
2400 [ 'Cannot find a place to create a package directory.'-[],
2401 'Considered:'-[]
2402 ],
2403 candidate_dirs(PackDirs).
2404message(no_match(Name)) -->
2405 [ 'No registered pack matches "~w"'-[Name] ].
2406message(conflict(version, [PackV, FileV])) -->
2407 ['Version mismatch: pack.pl: '-[]], msg_version(PackV),
2408 [', file claims version '-[]], msg_version(FileV).
2409message(conflict(name, [PackInfo, FileInfo])) -->
2410 ['Pack ~w mismatch: pack.pl: ~p'-[PackInfo]],
2411 [', file claims ~w: ~p'-[FileInfo]].
2412message(no_prolog_response(ContentType, String)) -->
2413 [ 'Expected Prolog response. Got content of type ~p'-[ContentType], nl,
2414 '~s'-[String]
2415 ].
2416message(pack(no_upgrade_info(Pack))) -->
2417 [ '~w: pack meta-data does not provide an upgradable URL'-[Pack] ].
2418
2419candidate_dirs([]) --> [].
2420candidate_dirs([H|T]) --> [ nl, ' ~w'-[H] ], candidate_dirs(T).
2421
2422message(no_mingw) -->
2423 [ 'Cannot find MinGW and/or MSYS.'-[] ].
2424
2425 2426message(resolve_remove) -->
2427 [ nl, 'Please select an action:', nl, nl ].
2428message(create_pack_dir) -->
2429 [ nl, 'Create directory for packages', nl ].
2430message(menu(item(I, Label))) -->
2431 [ '~t(~d)~6| '-[I] ],
2432 label(Label).
2433message(menu(default_item(I, Label))) -->
2434 [ '~t(~d)~6| * '-[I] ],
2435 label(Label).
2436message(menu(select)) -->
2437 [ nl, 'Your choice? ', flush ].
2438message(confirm(Question, Default)) -->
2439 message(Question),
2440 confirm_default(Default),
2441 [ flush ].
2442message(menu(reply(Min,Max))) -->
2443 ( { Max =:= Min+1 }
2444 -> [ 'Please enter ~w or ~w'-[Min,Max] ]
2445 ; [ 'Please enter a number between ~w and ~w'-[Min,Max] ]
2446 ).
2447
2449
2450message(alt_hashes(URL, _Alts)) -->
2451 { git_url(URL, _)
2452 },
2453 !,
2454 [ 'GIT repository was updated without updating version' ].
2455message(alt_hashes(URL, Alts)) -->
2456 { file_base_name(URL, File)
2457 },
2458 [ 'Found multiple versions of "~w".'-[File], nl,
2459 'This could indicate a compromised or corrupted file', nl
2460 ],
2461 alt_hashes(Alts).
2462message(continue_with_alt_hashes(Count, URL)) -->
2463 [ 'Continue installation from "~w" (downloaded ~D times)'-[URL, Count] ].
2464message(continue_with_modified_hash(_URL)) -->
2465 [ 'Pack may be compromised. Continue anyway'
2466 ].
2467message(modified_hash(_SHA1-URL, _SHA2-[URL])) -->
2468 [ 'Content of ~q has changed.'-[URL]
2469 ].
2470
2471alt_hashes([]) --> [].
2472alt_hashes([H|T]) --> alt_hash(H), ( {T == []} -> [] ; [nl], alt_hashes(T) ).
2473
2474alt_hash(alt_hash(Count, URLs, Hash)) -->
2475 [ '~t~d~8| ~w'-[Count, Hash] ],
2476 alt_urls(URLs).
2477
2478alt_urls([]) --> [].
2479alt_urls([H|T]) -->
2480 [ nl, ' ~w'-[H] ],
2481 alt_urls(T).
2482
2484
2485message(install_dependencies(Resolution)) -->
2486 [ 'Package depends on the following:' ],
2487 msg_res_tokens(Resolution, 1).
2488
2489msg_res_tokens([], _) --> [].
2490msg_res_tokens([H|T], L) --> msg_res_token(H, L), msg_res_tokens(T, L).
2491
2492msg_res_token(Token-unresolved, L) -->
2493 res_indent(L),
2494 [ '"~w" cannot be satisfied'-[Token] ].
2495msg_res_token(Token-resolve(Pack, Version, [URL|_], SubResolves), L) -->
2496 !,
2497 res_indent(L),
2498 [ '"~w", provided by ~w@~w from ~w'-[Token, Pack, Version, URL] ],
2499 { L2 is L+1 },
2500 msg_res_tokens(SubResolves, L2).
2501msg_res_token(Token-resolved(Pack), L) -->
2502 !,
2503 res_indent(L),
2504 [ '"~w", provided by installed pack ~w'-[Token,Pack] ].
2505
2506res_indent(L) -->
2507 { I is L*2 },
2508 [ nl, '~*c'-[I,0'\s] ].
2509
2510message(resolve_deps) -->
2511 [ nl, 'What do you wish to do' ].
2512label(install_deps) -->
2513 [ 'Install proposed dependencies' ].
2514label(install_no_deps) -->
2515 [ 'Only install requested package' ].
2516
2517
2518message(git_fetch(Dir)) -->
2519 [ 'Running "git fetch" in ~q'-[Dir] ].
2520
2522
2523message(inquiry_ok(Reply, File)) -->
2524 { memberchk(downloads(Count), Reply),
2525 memberchk(rating(VoteCount, Rating), Reply),
2526 !,
2527 length(Stars, Rating),
2528 maplist(=(0'*), Stars)
2529 },
2530 [ '"~w" was downloaded ~D times. Package rated ~s (~D votes)'-
2531 [ File, Count, Stars, VoteCount ]
2532 ].
2533message(inquiry_ok(Reply, File)) -->
2534 { memberchk(downloads(Count), Reply)
2535 },
2536 [ '"~w" was downloaded ~D times'-[ File, Count ] ].
2537
2538 2539unsatisfied([]) --> [].
2540unsatisfied([Needed-[By]|T]) -->
2541 [ '\t`~q\', needed by package `~w\''-[Needed, By] ],
2542 unsatisfied(T).
2543unsatisfied([Needed-By|T]) -->
2544 [ '\t`~q\', needed by packages'-[Needed], nl ],
2545 pack_list(By),
2546 unsatisfied(T).
2547
2548pack_list([]) --> [].
2549pack_list([H|T]) -->
2550 [ '\t\tPackage `~w\''-[H], nl ],
2551 pack_list(T).
2552
2553process_lines([]) --> [].
2554process_lines([H|T]) -->
2555 [ '~s'-[H] ],
2556 ( {T==[]}
2557 -> []
2558 ; [nl], process_lines(T)
2559 ).
2560
2561split_lines([], []) :- !.
2562split_lines(All, [Line1|More]) :-
2563 append(Line1, [0'\n|Rest], All),
2564 !,
2565 split_lines(Rest, More).
2566split_lines(Line, [Line]).
2567
2568label(remove_only(Pack)) -->
2569 [ 'Only remove package ~w (break dependencies)'-[Pack] ].
2570label(remove_deps(Pack, Deps)) -->
2571 { length(Deps, Count) },
2572 [ 'Remove package ~w and ~D dependencies'-[Pack, Count] ].
2573label(create_dir(Dir)) -->
2574 [ '~w'-[Dir] ].
2575label(install_from(git(URL))) -->
2576 !,
2577 [ 'GIT repository at ~w'-[URL] ].
2578label(install_from(URL)) -->
2579 [ '~w'-[URL] ].
2580label(cancel) -->
2581 [ 'Cancel' ].
2582
2583confirm_default(yes) -->
2584 [ ' Y/n? ' ].
2585confirm_default(no) -->
2586 [ ' y/N? ' ].
2587confirm_default(none) -->
2588 [ ' y/n? ' ].
2589
2590msg_version(Version) -->
2591 { atom(Version) },
2592 !,
2593 [ '~w'-[Version] ].
2594msg_version(VersionData) -->
2595 !,
2596 { atom_version(Atom, VersionData) },
2597 [ '~w'-[Atom] ]