36
37:- module(prolog_pack,
38 [ pack_list_installed/0,
39 pack_info/1, 40 pack_list/1, 41 pack_list/2, 42 pack_search/1, 43 pack_install/1, 44 pack_install/2, 45 pack_install_local/3, 46 pack_upgrade/1, 47 pack_rebuild/1, 48 pack_rebuild/0, 49 pack_remove/1, 50 pack_remove/2, 51 pack_publish/2, 52 pack_property/2 53 ]). 54:- use_module(library(apply)). 55:- use_module(library(error)). 56:- use_module(library(option)). 57:- use_module(library(readutil)). 58:- use_module(library(lists)). 59:- use_module(library(filesex)). 60:- use_module(library(xpath)). 61:- use_module(library(settings)). 62:- use_module(library(uri)). 63:- use_module(library(dcg/basics)). 64:- use_module(library(dcg/high_order)). 65:- use_module(library(http/http_open)). 66:- use_module(library(http/json)). 67:- use_module(library(http/http_client), []). 68:- use_module(library(debug), [assertion/1]). 69:- use_module(library(pairs),
70 [pairs_keys/2, map_list_to_pairs/3, pairs_values/2]). 71:- autoload(library(git)). 72:- autoload(library(sgml)). 73:- autoload(library(sha)). 74:- autoload(library(build/tools)). 75:- autoload(library(ansi_term), [ansi_format/3]). 76:- autoload(library(pprint), [print_term/2]). 77:- autoload(library(prolog_versions), [require_version/3, cmp_versions/3]). 78:- autoload(library(ugraphs), [vertices_edges_to_ugraph/3, ugraph_layers/2]). 79:- autoload(library(process), [process_which/2]). 80:- autoload(library(aggregate), [aggregate_all/3]). 81
82:- meta_predicate
83 pack_install_local(2, +, +). 84
97
98 101
102:- setting(server, atom, 'https://www.swi-prolog.org/pack/',
103 'Server to exchange pack information'). 104
105
106 109
110:- op(900, xfx, @). 111
112:- meta_predicate det_if(0,0). 113
114 117
122
123current_pack(Pack) :-
124 current_pack(Pack, _).
125
126current_pack(Pack, Dir) :-
127 '$pack':pack(Pack, Dir).
128
133
134pack_list_installed :-
135 pack_list('', [installed(true)]),
136 validate_dependencies.
137
141
142pack_info(Name) :-
143 pack_info(info, Name).
144
145pack_info(Level, Name) :-
146 must_be(atom, Name),
147 findall(Info, pack_info(Name, Level, Info), Infos0),
148 ( Infos0 == []
149 -> print_message(warning, pack(no_pack_installed(Name))),
150 fail
151 ; true
152 ),
153 findall(Def, pack_default(Level, Infos, Def), Defs),
154 append(Infos0, Defs, Infos1),
155 sort(Infos1, Infos),
156 show_info(Name, Infos, [info(Level)]).
157
158
159show_info(_Name, _Properties, Options) :-
160 option(silent(true), Options),
161 !.
162show_info(_Name, _Properties, Options) :-
163 option(show_info(false), Options),
164 !.
165show_info(Name, Properties, Options) :-
166 option(info(list), Options),
167 !,
168 memberchk(title(Title), Properties),
169 memberchk(version(Version), Properties),
170 format('i ~w@~w ~28|- ~w~n', [Name, Version, Title]).
171show_info(Name, Properties, _) :-
172 !,
173 print_property_value('Package'-'~w', [Name]),
174 findall(Term, pack_level_info(info, Term, _, _), Terms),
175 maplist(print_property(Properties), Terms).
176
177print_property(_, nl) :-
178 !,
179 format('~n').
180print_property(Properties, Term) :-
181 findall(Term, member(Term, Properties), Terms),
182 Terms \== [],
183 !,
184 pack_level_info(_, Term, LabelFmt, _Def),
185 ( LabelFmt = Label-FmtElem
186 -> true
187 ; Label = LabelFmt,
188 FmtElem = '~w'
189 ),
190 multi_valued(Terms, FmtElem, FmtList, Values),
191 atomic_list_concat(FmtList, ', ', Fmt),
192 print_property_value(Label-Fmt, Values).
193print_property(_, _).
194
195multi_valued([H], LabelFmt, [LabelFmt], Values) :-
196 !,
197 H =.. [_|Values].
198multi_valued([H|T], LabelFmt, [LabelFmt|LT], Values) :-
199 H =.. [_|VH],
200 append(VH, MoreValues, Values),
201 multi_valued(T, LabelFmt, LT, MoreValues).
202
203
204pvalue_column(29).
205print_property_value(Prop-Fmt, Values) :-
206 !,
207 pvalue_column(C),
208 atomic_list_concat(['~w:~t~*|', Fmt, '~n'], Format),
209 format(Format, [Prop,C|Values]).
210
211pack_info(Name, Level, Info) :-
212 '$pack':pack(Name, BaseDir),
213 pack_dir_info(BaseDir, Level, Info).
214
215pack_dir_info(BaseDir, Level, Info) :-
216 ( Info = directory(BaseDir)
217 ; pack_info_term(BaseDir, Info)
218 ),
219 pack_level_info(Level, Info, _Format, _Default).
220
221:- public pack_level_info/4. 222
223pack_level_info(_, title(_), 'Title', '<no title>').
224pack_level_info(_, version(_), 'Installed version', '<unknown>').
225pack_level_info(info, automatic(_), 'Automatic (dependency only)', -).
226pack_level_info(info, directory(_), 'Installed in directory', -).
227pack_level_info(info, link(_), 'Installed as link to'-'~w', -).
228pack_level_info(info, built(_,_), 'Built on'-'~w for SWI-Prolog ~w', -).
229pack_level_info(info, author(_, _), 'Author'-'~w <~w>', -).
230pack_level_info(info, maintainer(_, _), 'Maintainer'-'~w <~w>', -).
231pack_level_info(info, packager(_, _), 'Packager'-'~w <~w>', -).
232pack_level_info(info, home(_), 'Home page', -).
233pack_level_info(info, download(_), 'Download URL', -).
234pack_level_info(_, provides(_), 'Provides', -).
235pack_level_info(_, requires(_), 'Requires', -).
236pack_level_info(_, conflicts(_), 'Conflicts with', -).
237pack_level_info(_, replaces(_), 'Replaces packages', -).
238pack_level_info(info, library(_), 'Provided libraries', -).
239
240pack_default(Level, Infos, Def) :-
241 pack_level_info(Level, ITerm, _Format, Def),
242 Def \== (-),
243 \+ memberchk(ITerm, Infos).
244
248
249pack_info_term(BaseDir, Info) :-
250 directory_file_path(BaseDir, 'pack.pl', InfoFile),
251 catch(
252 term_in_file(valid_term(pack_info_term), InfoFile, Info),
253 error(existence_error(source_sink, InfoFile), _),
254 ( print_message(error, pack(no_meta_data(BaseDir))),
255 fail
256 )).
257pack_info_term(BaseDir, library(Lib)) :-
258 atom_concat(BaseDir, '/prolog/', LibDir),
259 atom_concat(LibDir, '*.pl', Pattern),
260 expand_file_name(Pattern, Files),
261 maplist(atom_concat(LibDir), Plain, Files),
262 convlist(base_name, Plain, Libs),
263 member(Lib, Libs).
264pack_info_term(BaseDir, automatic(Boolean)) :-
265 once(pack_status_dir(BaseDir, automatic(Boolean))).
266pack_info_term(BaseDir, built(Arch, Prolog)) :-
267 pack_status_dir(BaseDir, built(Arch, Prolog, _How)).
268pack_info_term(BaseDir, link(Dest)) :-
269 read_link(BaseDir, _, Dest).
270
271base_name(File, Base) :-
272 file_name_extension(Base, pl, File).
273
277
278:- meta_predicate
279 term_in_file(1, +, -). 280
281term_in_file(Valid, File, Term) :-
282 exists_file(File),
283 setup_call_cleanup(
284 open(File, read, In, [encoding(utf8)]),
285 term_in_stream(Valid, In, Term),
286 close(In)).
287
288term_in_stream(Valid, In, Term) :-
289 repeat,
290 read_term(In, Term0, []),
291 ( Term0 == end_of_file
292 -> !, fail
293 ; Term = Term0,
294 call(Valid, Term0)
295 ).
296
297:- meta_predicate
298 valid_term(1,+). 299
300valid_term(Type, Term) :-
301 Term =.. [Name|Args],
302 same_length(Args, Types),
303 Decl =.. [Name|Types],
304 ( call(Type, Decl)
305 -> maplist(valid_info_arg, Types, Args)
306 ; print_message(warning, pack(invalid_term(Type, Term))),
307 fail
308 ).
309
310valid_info_arg(Type, Arg) :-
311 must_be(Type, Arg).
312
317
318pack_info_term(name(atom)). 319pack_info_term(title(atom)).
320pack_info_term(keywords(list(atom))).
321pack_info_term(description(list(atom))).
322pack_info_term(version(version)).
323pack_info_term(author(atom, email_or_url_or_empty)). 324pack_info_term(maintainer(atom, email_or_url)).
325pack_info_term(packager(atom, email_or_url)).
326pack_info_term(pack_version(nonneg)). 327pack_info_term(home(atom)). 328pack_info_term(download(atom)). 329pack_info_term(provides(atom)). 330pack_info_term(requires(dependency)).
331pack_info_term(conflicts(dependency)). 332pack_info_term(replaces(atom)). 333pack_info_term(autoload(boolean)). 334
335:- multifile
336 error:has_type/2. 337
338error:has_type(version, Version) :-
339 atom(Version),
340 is_version(Version).
341error:has_type(email_or_url, Address) :-
342 atom(Address),
343 ( sub_atom(Address, _, _, _, @)
344 -> true
345 ; uri_is_global(Address)
346 ).
347error:has_type(email_or_url_or_empty, Address) :-
348 ( Address == ''
349 -> true
350 ; error:has_type(email_or_url, Address)
351 ).
352error:has_type(dependency, Value) :-
353 is_dependency(Value).
354
355is_version(Version) :-
356 split_string(Version, ".", "", Parts),
357 maplist(number_string, _, Parts).
358
359is_dependency(Var) :-
360 var(Var),
361 !,
362 fail.
363is_dependency(Token) :-
364 atom(Token),
365 !.
366is_dependency(Term) :-
367 compound(Term),
368 compound_name_arguments(Term, Op, [Token,Version]),
369 atom(Token),
370 cmp(Op, _),
371 is_version(Version),
372 !.
373is_dependency(PrologToken) :-
374 is_prolog_token(PrologToken).
375
376cmp(<, @<).
377cmp(=<, @=<).
378cmp(==, ==).
379cmp(>=, @>=).
380cmp(>, @>).
381
382
383 386
426
427pack_list(Query) :-
428 pack_list(Query, []).
429
430pack_search(Query) :-
431 pack_list(Query, []).
432
433pack_list(Query, Options) :-
434 ( option(installed(true), Options)
435 ; option(outdated(true), Options)
436 ; option(server(false), Options)
437 ),
438 !,
439 local_search(Query, Local),
440 maplist(arg(1), Local, Packs),
441 ( option(server(false), Options)
442 -> Hits = []
443 ; query_pack_server(info(Packs), true(Hits), Options)
444 ),
445 list_hits(Hits, Local, Options).
446pack_list(Query, Options) :-
447 query_pack_server(search(Query), Result, Options),
448 ( Result == false
449 -> ( local_search(Query, Packs),
450 Packs \== []
451 -> forall(member(pack(Pack, Stat, Title, Version, _), Packs),
452 format('~w ~w@~w ~28|- ~w~n',
453 [Stat, Pack, Version, Title]))
454 ; print_message(warning, pack(search_no_matches(Query)))
455 )
456 ; Result = true(Hits), 457 local_search(Query, Local),
458 list_hits(Hits, Local, [])
459 ).
460
461list_hits(Hits, Local, Options) :-
462 append(Hits, Local, All),
463 sort(All, Sorted),
464 join_status(Sorted, Packs0),
465 include(filtered(Options), Packs0, Packs),
466 maplist(list_hit(Options), Packs).
467
468filtered(Options, pack(_,Tag,_,_,_)) :-
469 option(outdated(true), Options),
470 !,
471 Tag == 'U'.
472filtered(_, _).
473
474list_hit(_Options, pack(Pack, Tag, Title, Version, _URL)) =>
475 list_tag(Tag),
476 ansi_format(code, '~w', [Pack]),
477 format('@'),
478 list_version(Tag, Version),
479 format('~35|- ', []),
480 ansi_format(comment, '~w~n', [Title]).
481
482list_tag(Tag) :-
483 tag_color(Tag, Color),
484 ansi_format(Color, '~w ', [Tag]).
485
486list_version(Tag, VersionI-VersionS) =>
487 tag_color(Tag, Color),
488 ansi_format(Color, '~w', [VersionI]),
489 ansi_format(bold, '(~w)', [VersionS]).
490list_version(_Tag, Version) =>
491 ansi_format([], '~w', [Version]).
492
493tag_color('U', warning) :- !.
494tag_color('A', comment) :- !.
495tag_color(_, []).
496
503
504join_status([], []).
505join_status([ pack(Pack, i, Title, Version, URL),
506 pack(Pack, p, Title, Version, _)
507 | T0
508 ],
509 [ pack(Pack, Tag, Title, Version, URL)
510 | T
511 ]) :-
512 !,
513 ( pack_status(Pack, automatic(true))
514 -> Tag = a
515 ; Tag = i
516 ),
517 join_status(T0, T).
518join_status([ pack(Pack, i, Title, VersionI, URLI),
519 pack(Pack, p, _, VersionS, URLS)
520 | T0
521 ],
522 [ pack(Pack, Tag, Title, VersionI-VersionS, URLI-URLS)
523 | T
524 ]) :-
525 !,
526 version_sort_key(VersionI, VDI),
527 version_sort_key(VersionS, VDS),
528 ( VDI @< VDS
529 -> Tag = 'U'
530 ; Tag = 'A'
531 ),
532 join_status(T0, T).
533join_status([ pack(Pack, i, Title, VersionI, URL)
534 | T0
535 ],
536 [ pack(Pack, l, Title, VersionI, URL)
537 | T
538 ]) :-
539 !,
540 join_status(T0, T).
541join_status([H|T0], [H|T]) :-
542 join_status(T0, T).
543
547
548local_search(Query, Packs) :-
549 findall(Pack, matching_installed_pack(Query, Pack), Packs).
550
551matching_installed_pack(Query, pack(Pack, i, Title, Version, URL)) :-
552 current_pack(Pack),
553 findall(Term,
554 ( pack_info(Pack, _, Term),
555 search_info(Term)
556 ), Info),
557 ( sub_atom_icasechk(Pack, _, Query)
558 -> true
559 ; memberchk(title(Title), Info),
560 sub_atom_icasechk(Title, _, Query)
561 ),
562 option(title(Title), Info, '<no title>'),
563 option(version(Version), Info, '<no version>'),
564 option(download(URL), Info, '<no download url>').
565
566search_info(title(_)).
567search_info(version(_)).
568search_info(download(_)).
569
570
571 574
672
673pack_install(Spec) :-
674 pack_default_options(Spec, Pack, [], Options),
675 pack_install(Pack, [pack(Pack)|Options]).
676
677pack_install(Specs, Options) :-
678 is_list(Specs),
679 !,
680 maplist(pack_options(Options), Specs, Pairs),
681 pack_install_dir(PackTopDir, Options),
682 pack_install_set(Pairs, PackTopDir, Options).
683pack_install(Spec, Options) :-
684 pack_default_options(Spec, Pack, Options, DefOptions),
685 ( option(already_installed(Installed), DefOptions)
686 -> print_message(informational, pack(already_installed(Installed)))
687 ; merge_options(Options, DefOptions, PackOptions),
688 pack_install_dir(PackTopDir, PackOptions),
689 pack_install_set([Pack-PackOptions], PackTopDir, Options)
690 ).
691
692pack_options(Options, Spec, Pack-PackOptions) :-
693 pack_default_options(Spec, Pack, Options, DefOptions),
694 merge_options(Options, DefOptions, PackOptions).
695
718
719
720pack_default_options(_Spec, Pack, OptsIn, Options) :- 721 option(already_installed(pack(Pack,_Version)), OptsIn),
722 !,
723 Options = OptsIn.
724pack_default_options(_Spec, Pack, OptsIn, Options) :- 725 option(url(URL), OptsIn),
726 !,
727 ( option(git(_), OptsIn)
728 -> Options = OptsIn
729 ; git_url(URL, Pack)
730 -> Options = [git(true)|OptsIn]
731 ; Options = OptsIn
732 ),
733 ( nonvar(Pack)
734 -> true
735 ; option(pack(Pack), Options)
736 -> true
737 ; pack_version_file(Pack, _Version, URL)
738 ).
739pack_default_options(Archive, Pack, OptsIn, Options) :- 740 must_be(atom, Archive),
741 \+ uri_is_global(Archive),
742 expand_file_name(Archive, [File]),
743 exists_file(File),
744 !,
745 ( pack_version_file(Pack, Version, File)
746 -> uri_file_name(FileURL, File),
747 merge_options([url(FileURL), version(Version)], OptsIn, Options)
748 ; domain_error(pack_file_name, Archive)
749 ).
750pack_default_options(URL, Pack, OptsIn, Options) :- 751 git_url(URL, Pack),
752 !,
753 merge_options([git(true), url(URL)], OptsIn, Options).
754pack_default_options(FileURL, Pack, _, Options) :- 755 uri_file_name(FileURL, Dir),
756 exists_directory(Dir),
757 pack_info_term(Dir, name(Pack)),
758 !,
759 ( pack_info_term(Dir, version(Version))
760 -> uri_file_name(DirURL, Dir),
761 Options = [url(DirURL), version(Version)]
762 ; throw(error(existence_error(key, version, Dir),_))
763 ).
764pack_default_options('.', Pack, OptsIn, Options) :- 765 pack_info_term('.', name(Pack)),
766 !,
767 working_directory(Dir, Dir),
768 ( pack_info_term(Dir, version(Version))
769 -> uri_file_name(DirURL, Dir),
770 NewOptions = [url(DirURL), version(Version) | Options1],
771 ( current_prolog_flag(windows, true)
772 -> Options1 = []
773 ; Options1 = [link(true), rebuild(make)]
774 ),
775 merge_options(NewOptions, OptsIn, Options)
776 ; throw(error(existence_error(key, version, Dir),_))
777 ).
778pack_default_options(URL, Pack, OptsIn, Options) :- 779 pack_version_file(Pack, Version, URL),
780 download_url(URL),
781 !,
782 available_download_versions(URL, Available, Options),
783 Available = [URLVersion-LatestURL|_],
784 NewOptions = [url(LatestURL)|VersionOptions],
785 version_options(Version, URLVersion, Available, VersionOptions),
786 merge_options(NewOptions, OptsIn, Options).
787pack_default_options(Pack, Pack, Options, Options) :- 788 \+ uri_is_global(Pack).
789
790version_options(Version, Version, _, [version(Version)]) :- !.
791version_options(Version, _, Available, [versions(Available)]) :-
792 sub_atom(Version, _, _, _, *),
793 !.
794version_options(_, _, _, []).
795
813
814pack_install_dir(PackDir, Options) :-
815 option(pack_directory(PackDir), Options),
816 ensure_directory(PackDir),
817 !.
818pack_install_dir(PackDir, Options) :-
819 base_alias(Alias, Options),
820 absolute_file_name(Alias, PackDir,
821 [ file_type(directory),
822 access(write),
823 file_errors(fail)
824 ]),
825 !.
826pack_install_dir(PackDir, Options) :-
827 pack_create_install_dir(PackDir, Options).
828
829base_alias(Alias, Options) :-
830 option(global(true), Options),
831 !,
832 Alias = common_app_data(pack).
833base_alias(Alias, Options) :-
834 option(global(false), Options),
835 !,
836 Alias = user_app_data(pack).
837base_alias(Alias, _Options) :-
838 Alias = pack('.').
839
840pack_create_install_dir(PackDir, Options) :-
841 base_alias(Alias, Options),
842 findall(Candidate = create_dir(Candidate),
843 ( absolute_file_name(Alias, Candidate, [solutions(all)]),
844 \+ exists_file(Candidate),
845 \+ exists_directory(Candidate),
846 file_directory_name(Candidate, Super),
847 ( exists_directory(Super)
848 -> access_file(Super, write)
849 ; true
850 )
851 ),
852 Candidates0),
853 list_to_set(Candidates0, Candidates), 854 pack_create_install_dir(Candidates, PackDir, Options).
855
856pack_create_install_dir(Candidates, PackDir, Options) :-
857 Candidates = [Default=_|_],
858 !,
859 append(Candidates, [cancel=cancel], Menu),
860 menu(pack(create_pack_dir), Menu, Default, Selected, Options),
861 Selected \== cancel,
862 ( catch(make_directory_path(Selected), E,
863 (print_message(warning, E), fail))
864 -> PackDir = Selected
865 ; delete(Candidates, PackDir=create_dir(PackDir), Remaining),
866 pack_create_install_dir(Remaining, PackDir, Options)
867 ).
868pack_create_install_dir(_, _, _) :-
869 print_message(error, pack(cannot_create_dir(pack(.)))),
870 fail.
871
883
884pack_unpack_from_local(Source0, PackTopDir, Name, PackDir, Options) :-
885 exists_directory(Source0),
886 remove_slash(Source0, Source),
887 !,
888 directory_file_path(PackTopDir, Name, PackDir),
889 ( option(link(true), Options)
890 -> ( same_file(Source, PackDir)
891 -> true
892 ; remove_existing_pack(PackDir, Options),
893 atom_concat(PackTopDir, '/', PackTopDirS),
894 relative_file_name(Source, PackTopDirS, RelPath),
895 link_file(RelPath, PackDir, symbolic),
896 assertion(same_file(Source, PackDir))
897 )
898 ; \+ option(git(false), Options),
899 is_git_directory(Source)
900 -> remove_existing_pack(PackDir, Options),
901 run_process(path(git), [clone, Source, PackDir], [])
902 ; prepare_pack_dir(PackDir, Options),
903 copy_directory(Source, PackDir)
904 ).
905pack_unpack_from_local(Source, PackTopDir, Name, PackDir, Options) :-
906 exists_file(Source),
907 directory_file_path(PackTopDir, Name, PackDir),
908 prepare_pack_dir(PackDir, Options),
909 pack_unpack(Source, PackDir, Name, Options).
910
917
918:- if(exists_source(library(archive))). 919pack_unpack(Source, PackDir, Pack, Options) :-
920 ensure_loaded_archive,
921 pack_archive_info(Source, Pack, _Info, StripOptions),
922 prepare_pack_dir(PackDir, Options),
923 archive_extract(Source, PackDir,
924 [ exclude(['._*']) 925 | StripOptions
926 ]).
927:- else. 928pack_unpack(_,_,_,_) :-
929 existence_error(library, archive).
930:- endif. 931
937
938pack_install_local(M:Gen, Dir, Options) :-
939 findall(Pack-PackOptions, call(M:Gen, Pack, PackOptions), Pairs),
940 pack_install_set(Pairs, Dir, Options).
941
942pack_install_set(Pairs, Dir, Options) :-
943 must_be(list(pair), Pairs),
944 ensure_directory(Dir),
945 partition(known_media, Pairs, Local, Remote),
946 maplist(pack_options_to_versions, Local, LocalVersions),
947 ( Remote == []
948 -> AllVersions = LocalVersions
949 ; pairs_keys(Remote, Packs),
950 prolog_description(Properties),
951 query_pack_server(versions(Packs, Properties), Result, Options),
952 ( Result = true(RemoteVersions)
953 -> append(LocalVersions, RemoteVersions, AllVersions)
954 ; print_message(error, pack(query_failed(Result))),
955 fail
956 )
957 ),
958 local_packs(Dir, Existing),
959 pack_resolve(Pairs, Existing, AllVersions, Plan0, Options),
960 !, 961 maplist(hsts_info(Options), Plan0, Plan),
962 Options1 = [pack_directory(Dir)|Options],
963 download_plan(Pairs, Plan, PlanB, Options1),
964 register_downloads(PlanB, Options),
965 maplist(update_automatic, PlanB),
966 build_plan(PlanB, Built, Options1),
967 publish_download(PlanB, Options),
968 work_done(Pairs, Plan, PlanB, Built, Options).
969
970hsts_info(Options, Info0, Info) :-
971 hsts(Info0.get(url), URL, Options),
972 !,
973 Info = Info0.put(url, URL).
974hsts_info(_Options, Info, Info).
975
982
983known_media(_-Options) :-
984 option(url(_), Options).
985
1001
1002pack_resolve(Pairs, Existing, Versions, Plan, Options) :-
1003 insert_existing(Existing, Versions, AllVersions, Options),
1004 phrase(select_version(Pairs, AllVersions,
1005 [ plan(PlanA), 1006 dependency_for([]) 1007 | Options
1008 ]),
1009 PlanA),
1010 mark_installed(PlanA, Existing, Plan).
1011
1020
1021:- det(insert_existing/4). 1022insert_existing(Existing, [], Versions, _Options) =>
1023 maplist(existing_to_versions, Existing, Versions).
1024insert_existing(Existing, [Pack-Versions|T0], AllPackVersions, Options),
1025 select(Installed, Existing, Existing2),
1026 Installed.pack == Pack =>
1027 can_upgrade(Installed, Versions, Installed2),
1028 insert_existing_(Installed2, Versions, AllVersions, Options),
1029 AllPackVersions = [Pack-AllVersions|T],
1030 insert_existing(Existing2, T0, T, Options).
1031insert_existing(Existing, [H|T0], AllVersions, Options) =>
1032 AllVersions = [H|T],
1033 insert_existing(Existing, T0, T, Options).
1034
1035existing_to_versions(Installed, Pack-[Version-[Installed]]) :-
1036 Pack = Installed.pack,
1037 Version = Installed.version.
1038
1039insert_existing_(Installed, Versions, AllVersions, Options) :-
1040 option(upgrade(true), Options),
1041 !,
1042 insert_existing_(Installed, Versions, AllVersions).
1043insert_existing_(Installed, Versions, AllVersions, _) :-
1044 AllVersions = [Installed.version-[Installed]|Versions].
1045
1046insert_existing_(Installed, [H|T0], [H|T]) :-
1047 H = V0-_Infos,
1048 cmp_versions(>, V0, Installed.version),
1049 !,
1050 insert_existing_(Installed, T0, T).
1051insert_existing_(Installed, [H0|T], [H|T]) :-
1052 H0 = V0-Infos,
1053 V0 == Installed.version,
1054 !,
1055 H = V0-[Installed|Infos].
1056insert_existing_(Installed, Versions, All) :-
1057 All = [Installed.version-[Installed]|Versions].
1058
1063
1064can_upgrade(Info, [Version-_|_], Info2) :-
1065 cmp_versions(>, Version, Info.version),
1066 !,
1067 Info2 = Info.put(latest_version, Version).
1068can_upgrade(Info, _, Info).
1069
1075
1076mark_installed([], _, []).
1077mark_installed([Info|T], Existing, Plan) :-
1078 ( member(Installed, Existing),
1079 Installed.pack == Info.pack
1080 -> ( ( Installed.git == true
1081 -> Info.git == true,
1082 Installed.hash == Info.hash
1083 ; Version = Info.get(version)
1084 -> Installed.version == Version
1085 )
1086 -> Plan = [Info.put(keep, true)|PlanT] 1087 ; Plan = [Info.put(upgrade, Installed)|PlanT] 1088 )
1089 ; Plan = [Info|PlanT] 1090 ),
1091 mark_installed(T, Existing, PlanT).
1092
1098
1099select_version([], _, _) -->
1100 [].
1101select_version([Pack-PackOptions|More], Versions, Options) -->
1102 { memberchk(Pack-PackVersions, Versions),
1103 member(Version-Infos, PackVersions),
1104 compatible_version(Pack, Version, PackOptions),
1105 member(Info, Infos),
1106 pack_options_compatible_with_info(Info, PackOptions),
1107 pack_satisfies(Pack, Version, Info, Info2, PackOptions),
1108 all_downloads(PackVersions, Downloads)
1109 },
1110 add_to_plan(Info2.put(_{version: Version, all_downloads:Downloads}),
1111 Versions, Options),
1112 select_version(More, Versions, Options).
1113select_version([Pack-_PackOptions|_More], _Versions, _Options) -->
1114 { existence_error(pack, Pack) }. 1115
1116all_downloads(PackVersions, AllDownloads) :-
1117 aggregate_all(sum(Downloads),
1118 ( member(_Version-Infos, PackVersions),
1119 member(Info, Infos),
1120 get_dict(downloads, Info, Downloads)
1121 ),
1122 AllDownloads).
1123
1124add_requirements([], _, _) -->
1125 [].
1126add_requirements([H|T], Versions, Options) -->
1127 { is_prolog_token(H),
1128 !,
1129 prolog_satisfies(H)
1130 },
1131 add_requirements(T, Versions, Options).
1132add_requirements([H|T], Versions, Options) -->
1133 { member(Pack-PackVersions, Versions),
1134 member(Version-Infos, PackVersions),
1135 member(Info, Infos),
1136 ( Provides = @(Pack,Version)
1137 ; member(Provides, Info.get(provides))
1138 ),
1139 satisfies_req(Provides, H),
1140 all_downloads(PackVersions, Downloads)
1141 },
1142 add_to_plan(Info.put(_{version: Version, all_downloads:Downloads}),
1143 Versions, Options),
1144 add_requirements(T, Versions, Options).
1145
1151
1152add_to_plan(Info, _Versions, Options) -->
1153 { option(plan(Plan), Options),
1154 member_nonvar(Planned, Plan),
1155 Planned.pack == Info.pack,
1156 !,
1157 same_version(Planned, Info) 1158 }.
1159add_to_plan(Info, _Versions, _Options) -->
1160 { member(Conflict, Info.get(conflicts)),
1161 is_prolog_token(Conflict),
1162 prolog_satisfies(Conflict),
1163 !,
1164 fail 1165 }.
1166add_to_plan(Info, _Versions, Options) -->
1167 { option(plan(Plan), Options),
1168 member_nonvar(Planned, Plan),
1169 info_conflicts(Info, Planned), 1170 !,
1171 fail
1172 }.
1173add_to_plan(Info, Versions, Options) -->
1174 { select_option(dependency_for(Dep0), Options, Options1),
1175 Options2 = [dependency_for([Info.pack|Dep0])|Options1],
1176 ( Dep0 = [DepFor|_]
1177 -> add_dependency_for(DepFor, Info, Info1)
1178 ; Info1 = Info
1179 )
1180 },
1181 [Info1],
1182 add_requirements(Info.get(requires,[]), Versions, Options2).
1183
1184add_dependency_for(Pack, Info, Info) :-
1185 Old = Info.get(dependency_for),
1186 !,
1187 b_set_dict(dependency_for, Info, [Pack|Old]).
1188add_dependency_for(Pack, Info0, Info) :-
1189 Info = Info0.put(dependency_for, [Pack]).
1190
1191same_version(Info, Info) :-
1192 !.
1193same_version(Planned, Info) :-
1194 Hash = Planned.get(hash),
1195 Hash \== (-),
1196 !,
1197 Hash == Info.get(hash).
1198same_version(Planned, Info) :-
1199 Planned.get(version) == Info.get(version).
1200
1204
1205info_conflicts(Info, Planned) :-
1206 info_conflicts_(Info, Planned),
1207 !.
1208info_conflicts(Info, Planned) :-
1209 info_conflicts_(Planned, Info),
1210 !.
1211
1212info_conflicts_(Info, Planned) :-
1213 member(Conflict, Info.get(conflicts)),
1214 \+ is_prolog_token(Conflict),
1215 info_provides(Planned, Provides),
1216 satisfies_req(Provides, Conflict),
1217 !.
1218
1219info_provides(Info, Provides) :-
1220 ( Provides = Info.pack@Info.version
1221 ; member(Provides, Info.get(provides))
1222 ).
1223
1228
1229pack_satisfies(_Pack, _Version, Info0, Info, Options) :-
1230 option(commit('HEAD'), Options),
1231 !,
1232 Info0.get(git) == true,
1233 Info = Info0.put(commit, 'HEAD').
1234pack_satisfies(_Pack, _Version, Info, Info, Options) :-
1235 option(commit(Commit), Options),
1236 !,
1237 Commit == Info.get(hash).
1238pack_satisfies(Pack, Version, Info, Info, Options) :-
1239 option(version(ReqVersion), Options),
1240 !,
1241 satisfies_version(Pack, Version, ReqVersion).
1242pack_satisfies(_Pack, _Version, Info, Info, _Options).
1243
1245
1246satisfies_version(Pack, Version, ReqVersion) :-
1247 catch(require_version(pack(Pack), Version, ReqVersion),
1248 error(version_error(pack(Pack), Version, ReqVersion),_),
1249 fail).
1250
1254
1255satisfies_req(Token, Token) => true.
1256satisfies_req(@(Token,_), Token) => true.
1257satisfies_req(@(Token,PrvVersion), Req), cmp(Req, Token, Cmp, ReqVersion) =>
1258 cmp_versions(Cmp, PrvVersion, ReqVersion).
1259satisfies_req(_,_) => fail.
1260
1261cmp(Token < Version, Token, <, Version).
1262cmp(Token =< Version, Token, =<, Version).
1263cmp(Token = Version, Token, =, Version).
1264cmp(Token == Version, Token, ==, Version).
1265cmp(Token >= Version, Token, >=, Version).
1266cmp(Token > Version, Token, >, Version).
1267
1278
1279:- det(pack_options_to_versions/2). 1280pack_options_to_versions(Pack-PackOptions, Pack-Versions) :-
1281 option(versions(Available), PackOptions), !,
1282 maplist(version_url_info(Pack, PackOptions), Available, Versions).
1283pack_options_to_versions(Pack-PackOptions, Pack-[Version-[Info]]) :-
1284 option(url(URL), PackOptions),
1285 findall(Prop, option_info_prop(PackOptions, Prop), Pairs),
1286 dict_create(Info, #,
1287 [ pack-Pack,
1288 url-URL
1289 | Pairs
1290 ]),
1291 Version = Info.get(version, '0.0.0').
1292
1293version_url_info(Pack, PackOptions, Version-URL, Version-[Info]) :-
1294 findall(Prop,
1295 ( option_info_prop(PackOptions, Prop),
1296 Prop \= version-_
1297 ),
1298 Pairs),
1299 dict_create(Info, #,
1300 [ pack-Pack,
1301 url-URL,
1302 version-Version
1303 | Pairs
1304 ]).
1305
1306option_info_prop(PackOptions, Prop-Value) :-
1307 option_info(Prop),
1308 Opt =.. [Prop,Value],
1309 option(Opt, PackOptions).
1310
1311option_info(git).
1312option_info(hash).
1313option_info(version).
1314option_info(branch).
1315option_info(link).
1316
1321
1322compatible_version(Pack, Version, PackOptions) :-
1323 option(version(ReqVersion), PackOptions),
1324 !,
1325 satisfies_version(Pack, Version, ReqVersion).
1326compatible_version(_, _, _).
1327
1332
1333pack_options_compatible_with_info(Info, PackOptions) :-
1334 findall(Prop, option_info_prop(PackOptions, Prop), Pairs),
1335 dict_create(Dict, _, Pairs),
1336 Dict >:< Info.
1337
1345
1346download_plan(_Targets, Plan, Plan, _Options) :-
1347 exclude(installed, Plan, []),
1348 !.
1349download_plan(Targets, Plan0, Plan, Options) :-
1350 confirm(download_plan(Plan0), yes, Options),
1351 maplist(download_from_info(Options), Plan0, Plan1),
1352 plan_unsatisfied_dependencies(Plan1, Deps),
1353 ( Deps == []
1354 -> Plan = Plan1
1355 ; print_message(informational, pack(new_dependencies(Deps))),
1356 prolog_description(Properties),
1357 query_pack_server(versions(Deps, Properties), Result, []),
1358 ( Result = true(Versions)
1359 -> pack_resolve(Targets, Plan1, Versions, Plan2, Options),
1360 !,
1361 download_plan(Targets, Plan2, Plan, Options)
1362 ; print_message(error, pack(query_failed(Result))),
1363 fail
1364 )
1365 ).
1366
1371
1372plan_unsatisfied_dependencies(Plan, Deps) :-
1373 phrase(plan_unsatisfied_dependencies(Plan, Plan), Deps).
1374
1375plan_unsatisfied_dependencies([], _) -->
1376 [].
1377plan_unsatisfied_dependencies([Info|Infos], Plan) -->
1378 { Deps = Info.get(requires) },
1379 plan_unsatisfied_requirements(Deps, Plan),
1380 plan_unsatisfied_dependencies(Infos, Plan).
1381
1382plan_unsatisfied_requirements([], _) -->
1383 [].
1384plan_unsatisfied_requirements([H|T], Plan) -->
1385 { is_prolog_token(H), 1386 prolog_satisfies(H)
1387 },
1388 !,
1389 plan_unsatisfied_requirements(T, Plan).
1390plan_unsatisfied_requirements([H|T], Plan) -->
1391 { member(Info, Plan),
1392 ( ( Version = Info.get(version)
1393 -> Provides = @(Info.get(pack), Version)
1394 ; Provides = Info.get(pack)
1395 )
1396 ; member(Provides, Info.get(provides))
1397 ),
1398 satisfies_req(Provides, H)
1399 }, !,
1400 plan_unsatisfied_requirements(T, Plan).
1401plan_unsatisfied_requirements([H|T], Plan) -->
1402 [H],
1403 plan_unsatisfied_requirements(T, Plan).
1404
1405
1411
1412build_plan(Plan, Ordered, Options) :-
1413 partition(needs_rebuild_from_info(Options), Plan, ToBuild, NoBuild),
1414 maplist(attach_from_info(Options), NoBuild),
1415 ( ToBuild == []
1416 -> Ordered = []
1417 ; order_builds(ToBuild, Ordered),
1418 confirm(build_plan(Ordered), yes, Options),
1419 maplist(exec_plan_rebuild_step(Options), Ordered)
1420 ).
1421
1422needs_rebuild_from_info(Options, Info) :-
1423 needs_rebuild(Info.installed, Options).
1424
1428
1429needs_rebuild(PackDir, Options) :-
1430 ( is_foreign_pack(PackDir, _),
1431 \+ is_built(PackDir, Options)
1432 -> true
1433 ; is_autoload_pack(PackDir, Options),
1434 post_install_autoload(PackDir, Options),
1435 fail
1436 ).
1437
1444
1445is_built(PackDir, _Options) :-
1446 current_prolog_flag(arch, Arch),
1447 prolog_version_dotted(Version), 1448 pack_status_dir(PackDir, built(Arch, Version, _)).
1449
1454
1455order_builds(ToBuild, Ordered) :-
1456 findall(Pack-Dep, dep_edge(ToBuild, Pack, Dep), Edges),
1457 maplist(get_dict(pack), ToBuild, Packs),
1458 vertices_edges_to_ugraph(Packs, Edges, Graph),
1459 ugraph_layers(Graph, Layers),
1460 append(Layers, PackNames),
1461 maplist(pack_info_from_name(ToBuild), PackNames, Ordered).
1462
1463dep_edge(Infos, Pack, Dep) :-
1464 member(Info, Infos),
1465 Pack = Info.pack,
1466 member(Dep, Info.get(dependency_for)),
1467 ( member(DepInfo, Infos),
1468 DepInfo.pack == Dep
1469 -> true
1470 ).
1471
1472:- det(pack_info_from_name/3). 1473pack_info_from_name(Infos, Pack, Info) :-
1474 member(Info, Infos),
1475 Info.pack == Pack,
1476 !.
1477
1481
1482exec_plan_rebuild_step(Options, Info) :-
1483 print_message(informational, pack(build(Info.pack, Info.installed))),
1484 pack_post_install(Info.pack, Info.installed, Options),
1485 attach_from_info(Options, Info).
1486
1490
1491attach_from_info(_Options, Info) :-
1492 Info.get(keep) == true,
1493 !.
1494attach_from_info(Options, Info) :-
1495 ( option(pack_directory(_Parent), Options)
1496 -> pack_attach(Info.installed, [duplicate(replace)])
1497 ; pack_attach(Info.installed, [])
1498 ).
1499
1507
1508download_from_info(Options, Info0, Info), option(dryrun(true), Options) =>
1509 print_term(Info0, [nl(true)]),
1510 Info = Info0.
1511download_from_info(_Options, Info0, Info), installed(Info0) =>
1512 Info = Info0.
1513download_from_info(_Options, Info0, Info),
1514 _{upgrade:OldInfo, git:true} :< Info0,
1515 is_git_directory(OldInfo.installed) =>
1516 PackDir = OldInfo.installed,
1517 git_checkout_version(PackDir, [commit(Info0.hash)]),
1518 reload_info(PackDir, Info0, Info).
1519download_from_info(Options, Info0, Info),
1520 _{upgrade:OldInfo} :< Info0 =>
1521 PackDir = OldInfo.installed,
1522 detach_pack(OldInfo.pack, PackDir),
1523 delete_directory_and_contents(PackDir),
1524 del_dict(upgrade, Info0, _, Info1),
1525 download_from_info(Options, Info1, Info).
1526download_from_info(Options, Info0, Info),
1527 _{url:URL, git:true} :< Info0, \+ have_git =>
1528 git_archive_url(URL, Archive, Options),
1529 download_from_info([git_url(URL)|Options],
1530 Info0.put(_{ url:Archive,
1531 git:false,
1532 git_url:URL
1533 }),
1534 Info1),
1535 1536 ( Info1.get(version) == Info0.get(version),
1537 Hash = Info0.get(hash)
1538 -> Info = Info1.put(hash, Hash)
1539 ; Info = Info1
1540 ).
1541download_from_info(Options, Info0, Info),
1542 _{url:URL} :< Info0 =>
1543 select_option(pack_directory(Dir), Options, Options1),
1544 select_option(version(_), Options1, Options2, _),
1545 download_info_extra(Info0, InstallOptions, Options2),
1546 pack_download_from_url(URL, Dir, Info0.pack,
1547 [ interactive(false),
1548 pack_dir(PackDir)
1549 | InstallOptions
1550 ]),
1551 reload_info(PackDir, Info0, Info).
1552
(Info, [git(true),commit(Hash)|Options], Options) :-
1554 Info.get(git) == true,
1555 !,
1556 Hash = Info.get(commit, 'HEAD').
1557download_info_extra(Info, [link(true)|Options], Options) :-
1558 Info.get(link) == true,
1559 !.
1560download_info_extra(_, Options, Options).
1561
1562installed(Info) :-
1563 _ = Info.get(installed).
1564
1565detach_pack(Pack, PackDir) :-
1566 ( current_pack(Pack, PackDir)
1567 -> '$pack_detach'(Pack, PackDir)
1568 ; true
1569 ).
1570
1577
1578reload_info(_PackDir, Info, Info) :-
1579 _ = Info.get(installed), 1580 !.
1581reload_info(PackDir, Info0, Info) :-
1582 local_pack_info(PackDir, Info1),
1583 Info = Info0.put(installed, PackDir)
1584 .put(downloaded, Info0.url)
1585 .put(Info1).
1586
1591
1592work_done(_, _, _, _, Options),
1593 option(silent(true), Options) =>
1594 true.
1595work_done(Targets, Plan, Plan, [], _Options) =>
1596 convlist(can_upgrade_target(Plan), Targets, CanUpgrade),
1597 ( CanUpgrade == []
1598 -> pairs_keys(Targets, Packs),
1599 print_message(informational, pack(up_to_date(Packs)))
1600 ; print_message(informational, pack(installed_can_upgrade(CanUpgrade)))
1601 ).
1602work_done(_, _, _, _, _) =>
1603 true.
1604
1605can_upgrade_target(Plan, Pack-_, Info) =>
1606 member(Info, Plan),
1607 Info.pack == Pack,
1608 !,
1609 _ = Info.get(latest_version).
1610
1615
1616local_packs(Dir, Packs) :-
1617 findall(Pack, pack_in_subdir(Dir, Pack), Packs).
1618
1619pack_in_subdir(Dir, Info) :-
1620 directory_member(Dir, PackDir,
1621 [ file_type(directory),
1622 hidden(false)
1623 ]),
1624 local_pack_info(PackDir, Info).
1625
1626local_pack_info(PackDir,
1627 #{ pack: Pack,
1628 version: Version,
1629 title: Title,
1630 hash: Hash,
1631 url: URL,
1632 git: IsGit,
1633 requires: Requires,
1634 provides: Provides,
1635 conflicts: Conflicts,
1636 installed: PackDir
1637 }) :-
1638 directory_file_path(PackDir, 'pack.pl', MetaFile),
1639 exists_file(MetaFile),
1640 file_base_name(PackDir, DirName),
1641 findall(Term, pack_dir_info(PackDir, _, Term), Info),
1642 option(pack(Pack), Info, DirName),
1643 option(title(Title), Info, '<no title>'),
1644 option(version(Version), Info, '<no version>'),
1645 option(download(URL), Info, '<no download url>'),
1646 findall(Req, member(requires(Req), Info), Requires),
1647 findall(Prv, member(provides(Prv), Info), Provides),
1648 findall(Cfl, member(conflicts(Cfl), Info), Conflicts),
1649 ( have_git,
1650 is_git_directory(PackDir)
1651 -> git_hash(Hash, [directory(PackDir)]),
1652 IsGit = true
1653 ; Hash = '-',
1654 IsGit = false
1655 ).
1656
1657
1658 1661
1670
1671prolog_description([prolog(swi(Version))]) :-
1672 prolog_version(Version).
1673
1674prolog_version(Version) :-
1675 current_prolog_flag(version_git, Version),
1676 !.
1677prolog_version(Version) :-
1678 prolog_version_dotted(Version).
1679
1680prolog_version_dotted(Version) :-
1681 current_prolog_flag(version_data, swi(Major, Minor, Patch, _)),
1682 VNumbers = [Major, Minor, Patch],
1683 atomic_list_concat(VNumbers, '.', Version).
1684
1689
1690is_prolog_token(Token), cmp(Token, prolog, _Cmp, _Version) => true.
1691is_prolog_token(prolog:Feature), atom(Feature) => true.
1692is_prolog_token(prolog:Feature), flag_value_feature(Feature, _Flag, _Value) =>
1693 true.
1694is_prolog_token(_) => fail.
1695
1708
1709prolog_satisfies(Token), cmp(Token, prolog, Cmp, ReqVersion) =>
1710 prolog_version(CurrentVersion),
1711 cmp_versions(Cmp, CurrentVersion, ReqVersion).
1712prolog_satisfies(prolog:library(Lib)), atom(Lib) =>
1713 exists_source(library(Lib)).
1714prolog_satisfies(prolog:Feature), atom(Feature) =>
1715 current_prolog_flag(Feature, true).
1716prolog_satisfies(prolog:Feature), flag_value_feature(Feature, Flag, Value) =>
1717 current_prolog_flag(Flag, Value).
1718
1719flag_value_feature(Feature, Flag, Value) :-
1720 compound(Feature),
1721 compound_name_arguments(Feature, Flag, [Value]),
1722 atom(Flag).
1723
1724
1725 1728
1740
1741:- if(exists_source(library(archive))). 1742ensure_loaded_archive :-
1743 current_predicate(archive_open/3),
1744 !.
1745ensure_loaded_archive :-
1746 use_module(library(archive)).
1747
1748pack_archive_info(Archive, Pack, [archive_size(Bytes)|Info], Strip) :-
1749 ensure_loaded_archive,
1750 size_file(Archive, Bytes),
1751 setup_call_cleanup(
1752 archive_open(Archive, Handle, []),
1753 ( repeat,
1754 ( archive_next_header(Handle, InfoFile)
1755 -> true
1756 ; !, fail
1757 )
1758 ),
1759 archive_close(Handle)),
1760 file_base_name(InfoFile, 'pack.pl'),
1761 atom_concat(Prefix, 'pack.pl', InfoFile),
1762 strip_option(Prefix, Pack, Strip),
1763 setup_call_cleanup(
1764 archive_open_entry(Handle, Stream),
1765 read_stream_to_terms(Stream, Info),
1766 close(Stream)),
1767 !,
1768 must_be(ground, Info),
1769 maplist(valid_term(pack_info_term), Info).
1770:- else. 1771pack_archive_info(_, _, _, _) :-
1772 existence_error(library, archive).
1773:- endif. 1774pack_archive_info(_, _, _, _) :-
1775 existence_error(pack_file, 'pack.pl').
1776
1777strip_option('', _, []) :- !.
1778strip_option('./', _, []) :- !.
1779strip_option(Prefix, Pack, [remove_prefix(Prefix)]) :-
1780 atom_concat(PrefixDir, /, Prefix),
1781 file_base_name(PrefixDir, Base),
1782 ( Base == Pack
1783 -> true
1784 ; pack_version_file(Pack, _, Base)
1785 -> true
1786 ; \+ sub_atom(PrefixDir, _, _, _, /)
1787 ).
1788
1789read_stream_to_terms(Stream, Terms) :-
1790 read(Stream, Term0),
1791 read_stream_to_terms(Term0, Stream, Terms).
1792
1793read_stream_to_terms(end_of_file, _, []) :- !.
1794read_stream_to_terms(Term0, Stream, [Term0|Terms]) :-
1795 read(Stream, Term1),
1796 read_stream_to_terms(Term1, Stream, Terms).
1797
1798
1803
1804pack_git_info(GitDir, Hash, [git(true), installed_size(Bytes)|Info]) :-
1805 exists_directory(GitDir),
1806 !,
1807 git_ls_tree(Entries, [directory(GitDir)]),
1808 git_hash(Hash, [directory(GitDir)]),
1809 maplist(arg(4), Entries, Sizes),
1810 sum_list(Sizes, Bytes),
1811 dir_metadata(GitDir, Info).
1812
1813dir_metadata(GitDir, Info) :-
1814 directory_file_path(GitDir, 'pack.pl', InfoFile),
1815 read_file_to_terms(InfoFile, Info, [encoding(utf8)]),
1816 maplist(valid_term(pack_info_term), Info).
1817
1821
1822download_file_sanity_check(Archive, Pack, Info) :-
1823 info_field(name(PackName), Info),
1824 info_field(version(PackVersion), Info),
1825 pack_version_file(PackFile, FileVersion, Archive),
1826 must_match([Pack, PackName, PackFile], name),
1827 must_match([PackVersion, FileVersion], version).
1828
1829info_field(Field, Info) :-
1830 memberchk(Field, Info),
1831 ground(Field),
1832 !.
1833info_field(Field, _Info) :-
1834 functor(Field, FieldName, _),
1835 print_message(error, pack(missing(FieldName))),
1836 fail.
1837
1838must_match(Values, _Field) :-
1839 sort(Values, [_]),
1840 !.
1841must_match(Values, Field) :-
1842 print_message(error, pack(conflict(Field, Values))),
1843 fail.
1844
1845
1846 1849
1861
1862prepare_pack_dir(Dir, Options) :-
1863 exists_directory(Dir),
1864 !,
1865 ( empty_directory(Dir)
1866 -> true
1867 ; remove_existing_pack(Dir, Options)
1868 -> make_directory(Dir)
1869 ).
1870prepare_pack_dir(Dir, _) :-
1871 ( read_link(Dir, _, _)
1872 ; access_file(Dir, exist)
1873 ),
1874 !,
1875 delete_file(Dir),
1876 make_directory(Dir).
1877prepare_pack_dir(Dir, _) :-
1878 make_directory(Dir).
1879
1883
1884empty_directory(Dir) :-
1885 \+ ( directory_files(Dir, Entries),
1886 member(Entry, Entries),
1887 \+ special(Entry)
1888 ).
1889
1890special(.).
1891special(..).
1892
1899
1900remove_existing_pack(PackDir, Options) :-
1901 exists_directory(PackDir),
1902 !,
1903 ( ( option(upgrade(true), Options)
1904 ; confirm(remove_existing_pack(PackDir), yes, Options)
1905 )
1906 -> delete_directory_and_contents(PackDir)
1907 ; print_message(error, pack(directory_exists(PackDir))),
1908 fail
1909 ).
1910remove_existing_pack(_, _).
1911
1925
1926pack_download_from_url(URL, PackTopDir, Pack, Options) :-
1927 option(git(true), Options),
1928 !,
1929 directory_file_path(PackTopDir, Pack, PackDir),
1930 prepare_pack_dir(PackDir, Options),
1931 ( option(branch(Branch), Options)
1932 -> Extra = ['--branch', Branch]
1933 ; Extra = []
1934 ),
1935 run_process(path(git), [clone, URL, PackDir|Extra], []),
1936 git_checkout_version(PackDir, [update(false)|Options]),
1937 option(pack_dir(PackDir), Options, _).
1938pack_download_from_url(URL0, PackTopDir, Pack, Options) :-
1939 download_url(URL0),
1940 !,
1941 hsts(URL0, URL, Options),
1942 directory_file_path(PackTopDir, Pack, PackDir),
1943 prepare_pack_dir(PackDir, Options),
1944 pack_download_dir(PackTopDir, DownLoadDir),
1945 download_file(URL, Pack, DownloadBase, Options),
1946 directory_file_path(DownLoadDir, DownloadBase, DownloadFile),
1947 ( option(insecure(true), Options, false)
1948 -> TLSOptions = [cert_verify_hook(ssl_verify)]
1949 ; TLSOptions = []
1950 ),
1951 print_message(informational, pack(download(begin, Pack, URL, DownloadFile))),
1952 setup_call_cleanup(
1953 http_open(URL, In, TLSOptions),
1954 setup_call_cleanup(
1955 open(DownloadFile, write, Out, [type(binary)]),
1956 copy_stream_data(In, Out),
1957 close(Out)),
1958 close(In)),
1959 print_message(informational, pack(download(end, Pack, URL, DownloadFile))),
1960 pack_archive_info(DownloadFile, Pack, Info, _),
1961 ( option(git_url(GitURL), Options)
1962 -> Origin = GitURL 1963 ; download_file_sanity_check(DownloadFile, Pack, Info),
1964 Origin = URL
1965 ),
1966 pack_unpack_from_local(DownloadFile, PackTopDir, Pack, PackDir, Options),
1967 pack_assert(PackDir, archive(DownloadFile, Origin)),
1968 option(pack_dir(PackDir), Options, _).
1969pack_download_from_url(URL, PackTopDir, Pack, Options) :-
1970 local_uri_file_name(URL, File),
1971 !,
1972 pack_unpack_from_local(File, PackTopDir, Pack, PackDir, Options),
1973 pack_assert(PackDir, archive(File, URL)),
1974 option(pack_dir(PackDir), Options, _).
1975pack_download_from_url(URL, _PackTopDir, _Pack, _Options) :-
1976 domain_error(url, URL).
1977
1999
2000git_checkout_version(PackDir, Options) :-
2001 option(commit('HEAD'), Options),
2002 option(branch(Branch), Options),
2003 !,
2004 git_ensure_on_branch(PackDir, Branch),
2005 run_process(path(git), ['-C', PackDir, pull], []).
2006git_checkout_version(PackDir, Options) :-
2007 option(commit('HEAD'), Options),
2008 git_current_branch(_, [directory(PackDir)]),
2009 !,
2010 run_process(path(git), ['-C', PackDir, pull], []).
2011git_checkout_version(PackDir, Options) :-
2012 option(commit('HEAD'), Options),
2013 !,
2014 git_default_branch(Branch, [directory(PackDir)]),
2015 git_ensure_on_branch(PackDir, Branch),
2016 run_process(path(git), ['-C', PackDir, pull], []).
2017git_checkout_version(PackDir, Options) :-
2018 option(commit(Hash), Options),
2019 run_process(path(git), ['-C', PackDir, fetch], []),
2020 git_branches(Branches, [contains(Hash), directory(PackDir)]),
2021 git_process_output(['-C', PackDir, 'rev-parse' | Branches],
2022 read_lines_to_atoms(Commits),
2023 []),
2024 nth1(I, Commits, Hash),
2025 nth1(I, Branches, Branch),
2026 !,
2027 git_ensure_on_branch(PackDir, Branch).
2028git_checkout_version(PackDir, Options) :-
2029 option(commit(Hash), Options),
2030 !,
2031 run_process(path(git), ['-C', PackDir, checkout, '--quiet', Hash], []).
2032git_checkout_version(PackDir, Options) :-
2033 option(version(Version), Options),
2034 !,
2035 git_tags(Tags, [directory(PackDir)]),
2036 ( memberchk(Version, Tags)
2037 -> Tag = Version
2038 ; member(Tag, Tags),
2039 sub_atom(Tag, B, _, 0, Version),
2040 sub_atom(Tag, 0, B, _, Prefix),
2041 version_prefix(Prefix)
2042 -> true
2043 ; existence_error(version_tag, Version)
2044 ),
2045 run_process(path(git), ['-C', PackDir, checkout, Tag], []).
2046git_checkout_version(_PackDir, Options) :-
2047 option(fresh(true), Options),
2048 !.
2049git_checkout_version(PackDir, _Options) :-
2050 git_current_branch(_, [directory(PackDir)]),
2051 !,
2052 run_process(path(git), ['-C', PackDir, pull], []).
2053git_checkout_version(PackDir, _Options) :-
2054 git_default_branch(Branch, [directory(PackDir)]),
2055 git_ensure_on_branch(PackDir, Branch),
2056 run_process(path(git), ['-C', PackDir, pull], []).
2057
2061
2062git_ensure_on_branch(PackDir, Branch) :-
2063 git_current_branch(Branch, [directory(PackDir)]),
2064 !.
2065git_ensure_on_branch(PackDir, Branch) :-
2066 run_process(path(git), ['-C', PackDir, checkout, Branch], []).
2067
2068read_lines_to_atoms(Atoms, In) :-
2069 read_line_to_string(In, Line),
2070 ( Line == end_of_file
2071 -> Atoms = []
2072 ; atom_string(Atom, Line),
2073 Atoms = [Atom|T],
2074 read_lines_to_atoms(T, In)
2075 ).
2076
2077version_prefix(Prefix) :-
2078 atom_codes(Prefix, Codes),
2079 phrase(version_prefix, Codes).
2080
2081version_prefix -->
2082 [C],
2083 { code_type(C, alpha) },
2084 !,
2085 version_prefix.
2086version_prefix -->
2087 "-".
2088version_prefix -->
2089 "_".
2090version_prefix -->
2091 "".
2092
2097
2098download_file(URL, Pack, File, Options) :-
2099 option(version(Version), Options),
2100 !,
2101 file_name_extension(_, Ext, URL),
2102 format(atom(File), '~w-~w.~w', [Pack, Version, Ext]).
2103download_file(URL, Pack, File, _) :-
2104 file_base_name(URL,Basename),
2105 no_int_file_name_extension(Tag,Ext,Basename),
2106 tag_version(Tag,Version),
2107 !,
2108 format(atom(File0), '~w-~w', [Pack, Version]),
2109 file_name_extension(File0, Ext, File).
2110download_file(URL, _, File, _) :-
2111 file_base_name(URL, File).
2112
2118
2119:- public pack_url_file/2. 2120pack_url_file(URL, FileID) :-
2121 github_release_url(URL, Pack, Version),
2122 !,
2123 download_file(URL, Pack, FileID, [version(Version)]).
2124pack_url_file(URL, FileID) :-
2125 file_base_name(URL, FileID).
2126
2131
2132:- public ssl_verify/5. 2133ssl_verify(_SSL,
2134 _ProblemCertificate, _AllCertificates, _FirstCertificate,
2135 _Error).
2136
2137pack_download_dir(PackTopDir, DownLoadDir) :-
2138 directory_file_path(PackTopDir, 'Downloads', DownLoadDir),
2139 ( exists_directory(DownLoadDir)
2140 -> true
2141 ; make_directory(DownLoadDir)
2142 ),
2143 ( access_file(DownLoadDir, write)
2144 -> true
2145 ; permission_error(write, directory, DownLoadDir)
2146 ).
2147
2153
2154download_url(URL) :-
2155 url_scheme(URL, Scheme),
2156 download_scheme(Scheme).
2157
2158url_scheme(URL, Scheme) :-
2159 atom(URL),
2160 uri_components(URL, Components),
2161 uri_data(scheme, Components, Scheme),
2162 atom(Scheme).
2163
2164download_scheme(http).
2165download_scheme(https).
2166
2175
2176hsts(URL0, URL, Options) :-
2177 option(insecure(true), Options, false),
2178 !,
2179 URL = URL0.
2180hsts(URL0, URL, _Options) :-
2181 url_scheme(URL0, http),
2182 !,
2183 uri_edit(scheme(https), URL0, URL).
2184hsts(URL, URL, _Options).
2185
2186
2194
2195pack_post_install(Pack, PackDir, Options) :-
2196 post_install_foreign(Pack, PackDir, Options),
2197 post_install_autoload(PackDir, Options),
2198 attach_packs(PackDir, [duplicate(warning)]).
2199
2205
2206pack_rebuild :-
2207 forall(current_pack(Pack),
2208 ( print_message(informational, pack(rebuild(Pack))),
2209 pack_rebuild(Pack)
2210 )).
2211
2212pack_rebuild(Pack) :-
2213 current_pack(Pack, PackDir),
2214 !,
2215 post_install_foreign(Pack, PackDir, [rebuild(true)]).
2216pack_rebuild(Pack) :-
2217 unattached_pack(Pack, PackDir),
2218 !,
2219 post_install_foreign(Pack, PackDir, [rebuild(true)]).
2220pack_rebuild(Pack) :-
2221 existence_error(pack, Pack).
2222
2223unattached_pack(Pack, BaseDir) :-
2224 directory_file_path(Pack, 'pack.pl', PackFile),
2225 absolute_file_name(pack(PackFile), PackPath,
2226 [ access(read),
2227 file_errors(fail)
2228 ]),
2229 file_directory_name(PackPath, BaseDir).
2230
2231
2232
2244
2245post_install_foreign(Pack, PackDir, Options) :-
2246 is_foreign_pack(PackDir, _),
2247 !,
2248 ( pack_info_term(PackDir, pack_version(Version))
2249 -> true
2250 ; Version = 1
2251 ),
2252 option(rebuild(Rebuild), Options, if_absent),
2253 current_prolog_flag(arch, Arch),
2254 prolog_version_dotted(PrologVersion),
2255 ( Rebuild == if_absent,
2256 foreign_present(PackDir, Arch)
2257 -> print_message(informational, pack(kept_foreign(Pack, Arch))),
2258 ( pack_status_dir(PackDir, built(Arch, _, _))
2259 -> true
2260 ; pack_assert(PackDir, built(Arch, PrologVersion, downloaded))
2261 )
2262 ; BuildSteps0 = [[dependencies], [configure], build, install, [test]],
2263 ( Rebuild == true
2264 -> BuildSteps1 = [distclean|BuildSteps0]
2265 ; BuildSteps1 = BuildSteps0
2266 ),
2267 ( option(test(false), Options)
2268 -> delete(BuildSteps1, [test], BuildSteps2)
2269 ; BuildSteps2 = BuildSteps1
2270 ),
2271 ( option(clean(true), Options)
2272 -> append(BuildSteps2, [[clean]], BuildSteps)
2273 ; BuildSteps = BuildSteps2
2274 ),
2275 build_steps(BuildSteps, PackDir, [pack_version(Version)|Options]),
2276 pack_assert(PackDir, built(Arch, PrologVersion, built))
2277 ).
2278post_install_foreign(_, _, _).
2279
2280
2288
2289foreign_present(PackDir, Arch) :-
2290 atomic_list_concat([PackDir, '/lib'], ForeignBaseDir),
2291 exists_directory(ForeignBaseDir),
2292 !,
2293 atomic_list_concat([PackDir, '/lib/', Arch], ForeignDir),
2294 exists_directory(ForeignDir),
2295 current_prolog_flag(shared_object_extension, Ext),
2296 atomic_list_concat([ForeignDir, '/*.', Ext], Pattern),
2297 expand_file_name(Pattern, Files),
2298 Files \== [].
2299
2304
2305is_foreign_pack(PackDir, Type) :-
2306 foreign_file(File, Type),
2307 directory_file_path(PackDir, File, Path),
2308 exists_file(Path).
2309
2310foreign_file('CMakeLists.txt', cmake).
2311foreign_file('configure', configure).
2312foreign_file('configure.in', autoconf).
2313foreign_file('configure.ac', autoconf).
2314foreign_file('Makefile.am', automake).
2315foreign_file('Makefile', make).
2316foreign_file('makefile', make).
2317foreign_file('conanfile.txt', conan).
2318foreign_file('conanfile.py', conan).
2319
2320
2321 2324
2328
2329post_install_autoload(PackDir, Options) :-
2330 is_autoload_pack(PackDir, Options),
2331 !,
2332 directory_file_path(PackDir, prolog, PrologLibDir),
2333 make_library_index(PrologLibDir).
2334post_install_autoload(_, _).
2335
2336is_autoload_pack(PackDir, Options) :-
2337 option(autoload(true), Options, true),
2338 pack_info_term(PackDir, autoload(true)).
2339
2340
2341 2344
2348
2349pack_upgrade(Pack) :-
2350 pack_install(Pack, [upgrade(true)]).
2351
2352
2353 2356
2367
2368pack_remove(Pack) :-
2369 pack_remove(Pack, []).
2370
2371pack_remove(Pack, Options) :-
2372 option(dependencies(false), Options),
2373 !,
2374 pack_remove_forced(Pack).
2375pack_remove(Pack, Options) :-
2376 ( dependents(Pack, Deps)
2377 -> ( option(dependencies(true), Options)
2378 -> true
2379 ; confirm_remove(Pack, Deps, Delete, Options)
2380 ),
2381 forall(member(P, Delete), pack_remove_forced(P))
2382 ; pack_remove_forced(Pack)
2383 ).
2384
2385pack_remove_forced(Pack) :-
2386 catch('$pack_detach'(Pack, BaseDir),
2387 error(existence_error(pack, Pack), _),
2388 fail),
2389 !,
2390 print_message(informational, pack(remove(BaseDir))),
2391 delete_directory_and_contents(BaseDir).
2392pack_remove_forced(Pack) :-
2393 unattached_pack(Pack, BaseDir),
2394 !,
2395 delete_directory_and_contents(BaseDir).
2396pack_remove_forced(Pack) :-
2397 print_message(informational, error(existence_error(pack, Pack),_)).
2398
2399confirm_remove(Pack, Deps, Delete, Options) :-
2400 print_message(warning, pack(depends(Pack, Deps))),
2401 menu(pack(resolve_remove),
2402 [ [Pack] = remove_only(Pack),
2403 [Pack|Deps] = remove_deps(Pack, Deps),
2404 [] = cancel
2405 ], [], Delete, Options),
2406 Delete \== [].
2407
2408
2409 2412
2463
2464pack_publish(Dir, Options) :-
2465 \+ download_url(Dir),
2466 is_git_directory(Dir), !,
2467 pack_git_info(Dir, _Hash, Metadata),
2468 prepare_repository(Dir, Metadata, Options),
2469 ( memberchk(download(URL), Metadata),
2470 git_url(URL, _)
2471 -> true
2472 ; option(remote(Remote), Options, origin),
2473 git_remote_url(Remote, RemoteURL, [directory(Dir)]),
2474 git_to_https_url(RemoteURL, URL)
2475 ),
2476 memberchk(version(Version), Metadata),
2477 pack_publish_(URL,
2478 [ version(Version)
2479 | Options
2480 ]).
2481pack_publish(Spec, Options) :-
2482 pack_publish_(Spec, Options).
2483
2484pack_publish_(Spec, Options) :-
2485 pack_default_options(Spec, Pack, Options, DefOptions),
2486 option(url(URL), DefOptions),
2487 valid_publish_url(URL, Options),
2488 prepare_build_location(Pack, Dir, Clean, Options),
2489 ( option(register(false), Options)
2490 -> InstallOptions = DefOptions
2491 ; InstallOptions = [publish(Pack)|DefOptions]
2492 ),
2493 call_cleanup(pack_install(Pack,
2494 [ pack(Pack)
2495 | InstallOptions
2496 ]),
2497 cleanup_publish(Clean, Dir)).
2498
2499cleanup_publish(true, Dir) :-
2500 !,
2501 delete_directory_and_contents(Dir).
2502cleanup_publish(_, _).
2503
2504valid_publish_url(URL, Options) :-
2505 option(register(Register), Options, true),
2506 ( Register == false
2507 -> true
2508 ; download_url(URL)
2509 -> true
2510 ; permission_error(publish, pack, URL)
2511 ).
2512
2513prepare_build_location(Pack, Dir, Clean, Options) :-
2514 ( option(pack_directory(Dir), Options)
2515 -> ensure_directory(Dir),
2516 ( option(clean(true), Options, true)
2517 -> delete_directory_contents(Dir)
2518 ; true
2519 )
2520 ; tmp_file(pack, Dir),
2521 make_directory(Dir),
2522 Clean = true
2523 ),
2524 ( option(isolated(false), Options)
2525 -> detach_pack(Pack, _),
2526 attach_packs(Dir, [search(first)])
2527 ; attach_packs(Dir, [replace(true)])
2528 ).
2529
2530
2531
2538
2539prepare_repository(_Dir, _Metadata, Options) :-
2540 option(register(false), Options),
2541 !.
2542prepare_repository(Dir, Metadata, Options) :-
2543 git_dir_must_be_clean(Dir),
2544 git_must_be_on_default_branch(Dir, Options),
2545 tag_git_dir(Dir, Metadata, Action, Options),
2546 confirm(git_push, yes, Options),
2547 run_process(path(git), ['-C', file(Dir), push ], []),
2548 ( Action = push_tag(Tag)
2549 -> run_process(path(git), ['-C', file(Dir), push, origin, Tag ], [])
2550 ; true
2551 ).
2552
2553git_dir_must_be_clean(Dir) :-
2554 git_describe(Description, [directory(Dir)]),
2555 ( sub_atom(Description, _, _, 0, '-DIRTY')
2556 -> print_message(error, pack(git_not_clean(Dir))),
2557 fail
2558 ; true
2559 ).
2560
2561git_must_be_on_default_branch(Dir, Options) :-
2562 ( option(branch(Default), Options)
2563 -> true
2564 ; git_default_branch(Default, [directory(Dir)])
2565 ),
2566 git_current_branch(Current, [directory(Dir)]),
2567 ( Default == Current
2568 -> true
2569 ; print_message(error,
2570 pack(git_branch_not_default(Dir, Default, Current))),
2571 fail
2572 ).
2573
2574
2580
2581tag_git_dir(Dir, Metadata, Action, Options) :-
2582 memberchk(version(Version), Metadata),
2583 atom_concat('V', Version, Tag),
2584 git_tags(Tags, [directory(Dir)]),
2585 ( memberchk(Tag, Tags)
2586 -> git_tag_is_consistent(Dir, Tag, Action, Options)
2587 ; format(string(Message), 'Release ~w', [Version]),
2588 findall(Opt, git_tag_option(Opt, Options), Argv,
2589 [ '-m', Message, Tag ]),
2590 confirm(git_tag(Tag), yes, Options),
2591 run_process(path(git), ['-C', file(Dir), tag | Argv ], []),
2592 Action = push_tag(Tag)
2593 ).
2594
2595git_tag_option('-s', Options) :- option(sign(true), Options, true).
2596git_tag_option('-f', Options) :- option(force(true), Options, true).
2597
2598git_tag_is_consistent(Dir, Tag, Action, Options) :-
2599 format(atom(TagRef), 'refs/tags/~w', [Tag]),
2600 format(atom(CommitRef), 'refs/tags/~w^{}', [Tag]),
2601 option(remote(Remote), Options, origin),
2602 git_ls_remote(Dir, LocalTags, [tags(true)]),
2603 memberchk(CommitHash-CommitRef, LocalTags),
2604 ( git_hash(CommitHash, [directory(Dir)])
2605 -> true
2606 ; print_message(error, pack(git_release_tag_not_at_head(Tag))),
2607 fail
2608 ),
2609 memberchk(TagHash-TagRef, LocalTags),
2610 git_ls_remote(Remote, RemoteTags, [tags(true)]),
2611 ( memberchk(RemoteCommitHash-CommitRef, RemoteTags),
2612 memberchk(RemoteTagHash-TagRef, RemoteTags)
2613 -> ( RemoteCommitHash == CommitHash,
2614 RemoteTagHash == TagHash
2615 -> Action = none
2616 ; print_message(error, pack(git_tag_out_of_sync(Tag))),
2617 fail
2618 )
2619 ; Action = push_tag(Tag)
2620 ).
2621
2627
2628git_to_https_url(URL, URL) :-
2629 download_url(URL),
2630 !.
2631git_to_https_url(GitURL, URL) :-
2632 atom_concat('git@github.com:', Repo, GitURL),
2633 !,
2634 atom_concat('https://github.com/', Repo, URL).
2635git_to_https_url(GitURL, _) :-
2636 print_message(error, pack(git_no_https(GitURL))),
2637 fail.
2638
2639
2640 2643
2664
2665pack_property(Pack, Property) :-
2666 findall(Pack-Property, pack_property_(Pack, Property), List),
2667 member(Pack-Property, List). 2668
2669pack_property_(Pack, Property) :-
2670 pack_info(Pack, _, Property).
2671pack_property_(Pack, Property) :-
2672 \+ \+ info_file(Property, _),
2673 '$pack':pack(Pack, BaseDir),
2674 access_file(BaseDir, read),
2675 directory_files(BaseDir, Files),
2676 member(File, Files),
2677 info_file(Property, Pattern),
2678 downcase_atom(File, Pattern),
2679 directory_file_path(BaseDir, File, InfoFile),
2680 arg(1, Property, InfoFile).
2681
2682info_file(readme(_), 'readme.txt').
2683info_file(readme(_), 'readme').
2684info_file(todo(_), 'todo.txt').
2685info_file(todo(_), 'todo').
2686
2687
2688 2691
2698
2699pack_version_file(Pack, Version, GitHubRelease) :-
2700 atomic(GitHubRelease),
2701 github_release_url(GitHubRelease, Pack, Version),
2702 !.
2703pack_version_file(Pack, Version, Path) :-
2704 atomic(Path),
2705 file_base_name(Path, File),
2706 no_int_file_name_extension(Base, _Ext, File),
2707 atom_codes(Base, Codes),
2708 ( phrase(pack_version(Pack, Version), Codes),
2709 safe_pack_name(Pack)
2710 -> true
2711 ).
2712
2713no_int_file_name_extension(Base, Ext, File) :-
2714 file_name_extension(Base0, Ext0, File),
2715 \+ atom_number(Ext0, _),
2716 !,
2717 Base = Base0,
2718 Ext = Ext0.
2719no_int_file_name_extension(File, '', File).
2720
2725
2726safe_pack_name(Name) :-
2727 atom_length(Name, Len),
2728 Len >= 3, 2729 atom_codes(Name, Codes),
2730 maplist(safe_pack_char, Codes),
2731 !.
2732
2733safe_pack_char(C) :- between(0'a, 0'z, C), !.
2734safe_pack_char(C) :- between(0'A, 0'Z, C), !.
2735safe_pack_char(C) :- between(0'0, 0'9, C), !.
2736safe_pack_char(0'_).
2737
2741
2742pack_version(Pack, Version) -->
2743 string(Codes), "-",
2744 version(Parts),
2745 !,
2746 { atom_codes(Pack, Codes),
2747 atomic_list_concat(Parts, '.', Version)
2748 }.
2749
2750version([H|T]) -->
2751 version_part(H),
2752 ( "."
2753 -> version(T)
2754 ; {T=[]}
2755 ).
2756
2757version_part(*) --> "*", !.
2758version_part(Int) --> integer(Int).
2759
2760
2761 2764
2765have_git :-
2766 process_which(path(git), _).
2767
2768
2772
2773git_url(URL, Pack) :-
2774 uri_components(URL, Components),
2775 uri_data(scheme, Components, Scheme),
2776 nonvar(Scheme), 2777 uri_data(path, Components, Path),
2778 ( Scheme == git
2779 -> true
2780 ; git_download_scheme(Scheme),
2781 file_name_extension(_, git, Path)
2782 ; git_download_scheme(Scheme),
2783 catch(git_ls_remote(URL, _, [refs(['HEAD']), error(_)]), _, fail)
2784 -> true
2785 ),
2786 file_base_name(Path, PackExt),
2787 ( file_name_extension(Pack, git, PackExt)
2788 -> true
2789 ; Pack = PackExt
2790 ),
2791 ( safe_pack_name(Pack)
2792 -> true
2793 ; domain_error(pack_name, Pack)
2794 ).
2795
2796git_download_scheme(http).
2797git_download_scheme(https).
2798
2805
2806github_release_url(URL, Pack, Version) :-
2807 uri_components(URL, Components),
2808 uri_data(authority, Components, 'github.com'),
2809 uri_data(scheme, Components, Scheme),
2810 download_scheme(Scheme),
2811 uri_data(path, Components, Path),
2812 github_archive_path(Archive,Pack,File),
2813 atomic_list_concat(Archive, /, Path),
2814 file_name_extension(Tag, Ext, File),
2815 github_archive_extension(Ext),
2816 tag_version(Tag, Version),
2817 !.
2818
2819github_archive_path(['',_User,Pack,archive,File],Pack,File).
2820github_archive_path(['',_User,Pack,archive,refs,tags,File],Pack,File).
2821
2822github_archive_extension(tgz).
2823github_archive_extension(zip).
2824
2829
2830tag_version(Tag, Version) :-
2831 version_tag_prefix(Prefix),
2832 atom_concat(Prefix, Version, Tag),
2833 is_version(Version).
2834
2835version_tag_prefix(v).
2836version_tag_prefix('V').
2837version_tag_prefix('').
2838
2839
2845
2846git_archive_url(URL, Archive, Options) :-
2847 uri_components(URL, Components),
2848 uri_data(authority, Components, 'github.com'),
2849 uri_data(path, Components, Path),
2850 atomic_list_concat(['', User, RepoGit], /, Path),
2851 $,
2852 remove_git_ext(RepoGit, Repo),
2853 git_archive_version(Version, Options),
2854 atomic_list_concat(['', User, Repo, zip, Version], /, ArchivePath),
2855 uri_edit([ path(ArchivePath),
2856 host('codeload.github.com')
2857 ],
2858 URL, Archive).
2859git_archive_url(URL, _, _) :-
2860 print_message(error, pack(no_git(URL))),
2861 fail.
2862
2863remove_git_ext(RepoGit, Repo) :-
2864 file_name_extension(Repo, git, RepoGit),
2865 !.
2866remove_git_ext(Repo, Repo).
2867
2868git_archive_version(Version, Options) :-
2869 option(commit(Version), Options),
2870 !.
2871git_archive_version(Version, Options) :-
2872 option(branch(Version), Options),
2873 !.
2874git_archive_version(Version, Options) :-
2875 option(version(Version), Options),
2876 !.
2877git_archive_version('HEAD', _).
2878
2879 2882
2895
2896register_downloads(_, Options) :-
2897 option(register(false), Options),
2898 !.
2899register_downloads(_, Options) :-
2900 option(publish(_), Options),
2901 !.
2902register_downloads(Infos, Options) :-
2903 convlist(download_data, Infos, Data),
2904 ( Data == []
2905 -> true
2906 ; query_pack_server(downloaded(Data), Reply, Options),
2907 ( option(do_publish(Pack), Options)
2908 -> ( member(Info, Infos),
2909 Info.pack == Pack
2910 -> true
2911 ),
2912 ( Reply = true(Actions),
2913 memberchk(Pack-Result, Actions)
2914 -> ( registered(Result)
2915 -> print_message(informational, pack(published(Info, Result)))
2916 ; print_message(error, pack(publish_failed(Info, Result))),
2917 fail
2918 )
2919 ; print_message(error, pack(publish_failed(Info, false)))
2920 )
2921 ; true
2922 )
2923 ).
2924
2925registered(git(_URL)).
2926registered(file(_URL)).
2927
2928publish_download(Infos, Options) :-
2929 select_option(publish(Pack), Options, Options1),
2930 !,
2931 register_downloads(Infos, [do_publish(Pack)|Options1]).
2932publish_download(_Infos, _Options).
2933
2944
2945download_data(Info, Data),
2946 Info.get(git) == true => 2947 Data = download(URL, Hash, Metadata),
2948 URL = Info.get(downloaded),
2949 pack_git_info(Info.installed, Hash, Metadata).
2950download_data(Info, Data),
2951 _{git_url:URL,hash:Hash} :< Info, Hash \== (-) =>
2952 Data = download(URL, Hash, Metadata), 2953 dir_metadata(Info.installed, Metadata).
2954download_data(Info, Data) => 2955 Data = download(URL, Hash, Metadata),
2956 URL = Info.get(downloaded),
2957 download_url(URL),
2958 pack_status_dir(Info.installed, archive(Archive, URL)),
2959 file_sha1(Archive, Hash),
2960 pack_archive_info(Archive, _Pack, Metadata, _).
2961
2966
2967query_pack_server(Query, Result, Options) :-
2968 ( option(server(ServerOpt), Options)
2969 -> server_url(ServerOpt, ServerBase)
2970 ; setting(server, ServerBase),
2971 ServerBase \== ''
2972 ),
2973 atom_concat(ServerBase, query, Server),
2974 format(codes(Data), '~q.~n', Query),
2975 info_level(Informational, Options),
2976 print_message(Informational, pack(contacting_server(Server))),
2977 setup_call_cleanup(
2978 http_open(Server, In,
2979 [ post(codes(application/'x-prolog', Data)),
2980 header(content_type, ContentType)
2981 ]),
2982 read_reply(ContentType, In, Result),
2983 close(In)),
2984 message_severity(Result, Level, Informational),
2985 print_message(Level, pack(server_reply(Result))).
2986
2987server_url(URL0, URL) :-
2988 uri_components(URL0, Components),
2989 uri_data(scheme, Components, Scheme),
2990 var(Scheme),
2991 !,
2992 atom_concat('https://', URL0, URL1),
2993 server_url(URL1, URL).
2994server_url(URL0, URL) :-
2995 uri_components(URL0, Components),
2996 uri_data(path, Components, ''),
2997 !,
2998 uri_edit([path('/pack/')], URL0, URL).
2999server_url(URL, URL).
3000
3001read_reply(ContentType, In, Result) :-
3002 sub_atom(ContentType, 0, _, _, 'application/x-prolog'),
3003 !,
3004 set_stream(In, encoding(utf8)),
3005 read(In, Result).
3006read_reply(ContentType, In, _Result) :-
3007 read_string(In, 500, String),
3008 print_message(error, pack(no_prolog_response(ContentType, String))),
3009 fail.
3010
3011info_level(Level, Options) :-
3012 option(silent(true), Options),
3013 !,
3014 Level = silent.
3015info_level(informational, _).
3016
3017message_severity(true(_), Informational, Informational).
3018message_severity(false, warning, _).
3019message_severity(exception(_), error, _).
3020
3021
3022 3025
3032
3033available_download_versions(URL, Versions, _Options) :-
3034 wildcard_pattern(URL),
3035 github_url(URL, User, Repo), 3036 !,
3037 findall(Version-VersionURL,
3038 github_version(User, Repo, Version, VersionURL),
3039 Versions).
3040available_download_versions(URL, Versions, Options) :-
3041 wildcard_pattern(URL0),
3042 !,
3043 hsts(URL0, URL, Options),
3044 file_directory_name(URL, DirURL0),
3045 ensure_slash(DirURL0, DirURL),
3046 print_message(informational, pack(query_versions(DirURL))),
3047 setup_call_cleanup(
3048 http_open(DirURL, In, []),
3049 load_html(stream(In), DOM,
3050 [ syntax_errors(quiet)
3051 ]),
3052 close(In)),
3053 findall(MatchingURL,
3054 absolute_matching_href(DOM, URL, MatchingURL),
3055 MatchingURLs),
3056 ( MatchingURLs == []
3057 -> print_message(warning, pack(no_matching_urls(URL)))
3058 ; true
3059 ),
3060 versioned_urls(MatchingURLs, VersionedURLs),
3061 sort_version_pairs(VersionedURLs, Versions),
3062 print_message(informational, pack(found_versions(Versions))).
3063available_download_versions(URL, [Version-URL], _Options) :-
3064 ( pack_version_file(_Pack, Version0, URL)
3065 -> Version = Version0
3066 ; Version = '0.0.0'
3067 ).
3068
3072
3073sort_version_pairs(Pairs, Sorted) :-
3074 map_list_to_pairs(version_pair_sort_key_, Pairs, Keyed),
3075 sort(1, @>=, Keyed, SortedKeyed),
3076 pairs_values(SortedKeyed, Sorted).
3077
3078version_pair_sort_key_(Version-_Data, Key) :-
3079 version_sort_key(Version, Key).
3080
3081version_sort_key(Version, Key) :-
3082 split_string(Version, ".", "", Parts),
3083 maplist(number_string, Key, Parts),
3084 !.
3085version_sort_key(Version, _) :-
3086 domain_error(version, Version).
3087
3091
3092github_url(URL, User, Repo) :-
3093 uri_components(URL, uri_components(https,'github.com',Path,_,_)),
3094 atomic_list_concat(['',User,Repo|_], /, Path).
3095
3096
3101
3102github_version(User, Repo, Version, VersionURI) :-
3103 atomic_list_concat(['',repos,User,Repo,tags], /, Path1),
3104 uri_components(ApiUri, uri_components(https,'api.github.com',Path1,_,_)),
3105 setup_call_cleanup(
3106 http_open(ApiUri, In,
3107 [ request_header('Accept'='application/vnd.github.v3+json')
3108 ]),
3109 json_read_dict(In, Dicts),
3110 close(In)),
3111 member(Dict, Dicts),
3112 atom_string(Tag, Dict.name),
3113 tag_version(Tag, Version),
3114 atom_string(VersionURI, Dict.zipball_url).
3115
3116wildcard_pattern(URL) :- sub_atom(URL, _, _, _, *).
3117wildcard_pattern(URL) :- sub_atom(URL, _, _, _, ?).
3118
3119ensure_slash(Dir, DirS) :-
3120 ( sub_atom(Dir, _, _, 0, /)
3121 -> DirS = Dir
3122 ; atom_concat(Dir, /, DirS)
3123 ).
3124
3125remove_slash(Dir0, Dir) :-
3126 Dir0 \== '/',
3127 atom_concat(Dir1, /, Dir0),
3128 !,
3129 remove_slash(Dir1, Dir).
3130remove_slash(Dir, Dir).
3131
3132absolute_matching_href(DOM, Pattern, Match) :-
3133 xpath(DOM, //a(@href), HREF),
3134 uri_normalized(HREF, Pattern, Match),
3135 wildcard_match(Pattern, Match).
3136
3137versioned_urls([], []).
3138versioned_urls([H|T0], List) :-
3139 file_base_name(H, File),
3140 ( pack_version_file(_Pack, Version, File)
3141 -> List = [Version-H|T]
3142 ; List = T
3143 ),
3144 versioned_urls(T0, T).
3145
3146
3147 3150
3156
3157pack_provides(Pack, Pack@Version) :-
3158 current_pack(Pack),
3159 once(pack_info(Pack, version, version(Version))).
3160pack_provides(Pack, Provides) :-
3161 findall(Prv, pack_info(Pack, dependency, provides(Prv)), PrvList),
3162 member(Provides, PrvList).
3163
3164pack_requires(Pack, Requires) :-
3165 current_pack(Pack),
3166 findall(Req, pack_info(Pack, dependency, requires(Req)), ReqList),
3167 member(Requires, ReqList).
3168
3169pack_conflicts(Pack, Conflicts) :-
3170 current_pack(Pack),
3171 findall(Cfl, pack_info(Pack, dependency, conflicts(Cfl)), CflList),
3172 member(Conflicts, CflList).
3173
3178
3179pack_depends_on(Pack, Dependency) :-
3180 ground(Pack),
3181 !,
3182 pack_requires(Pack, Requires),
3183 \+ is_prolog_token(Requires),
3184 pack_provides(Dependency, Provides),
3185 satisfies_req(Provides, Requires).
3186pack_depends_on(Pack, Dependency) :-
3187 ground(Dependency),
3188 !,
3189 pack_provides(Dependency, Provides),
3190 pack_requires(Pack, Requires),
3191 satisfies_req(Provides, Requires).
3192pack_depends_on(Pack, Dependency) :-
3193 current_pack(Pack),
3194 pack_depends_on(Pack, Dependency).
3195
3200
3201dependents(Pack, Deps) :-
3202 setof(Dep, dependent(Pack, Dep, []), Deps).
3203
3204dependent(Pack, Dep, Seen) :-
3205 pack_depends_on(Dep0, Pack),
3206 \+ memberchk(Dep0, Seen),
3207 ( Dep = Dep0
3208 ; dependent(Dep0, Dep, [Dep0|Seen])
3209 ).
3210
3214
3215validate_dependencies :-
3216 setof(Issue, pack_dependency_issue(_, Issue), Issues),
3217 !,
3218 print_message(warning, pack(dependency_issues(Issues))).
3219validate_dependencies.
3220
3230
3231pack_dependency_issue(Pack, Issue) :-
3232 current_pack(Pack),
3233 pack_dependency_issue_(Pack, Issue).
3234
3235pack_dependency_issue_(Pack, unsatisfied(Pack, Requires)) :-
3236 pack_requires(Pack, Requires),
3237 ( is_prolog_token(Requires)
3238 -> \+ prolog_satisfies(Requires)
3239 ; \+ ( pack_provides(_, Provides),
3240 satisfies_req(Provides, Requires) )
3241 ).
3242pack_dependency_issue_(Pack, conflicts(Pack, Conflicts)) :-
3243 pack_conflicts(Pack, Conflicts),
3244 ( is_prolog_token(Conflicts)
3245 -> prolog_satisfies(Conflicts)
3246 ; pack_provides(_, Provides),
3247 satisfies_req(Provides, Conflicts)
3248 ).
3249
3250
3251 3254
3268
3269pack_assert(PackDir, Fact) :-
3270 must_be(ground, Fact),
3271 findall(Term, pack_status_dir(PackDir, Term), Facts0),
3272 update_facts(Facts0, Fact, Facts),
3273 OpenOptions = [encoding(utf8), lock(exclusive)],
3274 status_file(PackDir, StatusFile),
3275 ( Facts == Facts0
3276 -> true
3277 ; Facts0 \== [],
3278 append(Facts0, New, Facts)
3279 -> setup_call_cleanup(
3280 open(StatusFile, append, Out, OpenOptions),
3281 maplist(write_fact(Out), New),
3282 close(Out))
3283 ; setup_call_cleanup(
3284 open(StatusFile, write, Out, OpenOptions),
3285 ( write_facts_header(Out),
3286 maplist(write_fact(Out), Facts)
3287 ),
3288 close(Out))
3289 ).
3290
3291update_facts([], Fact, [Fact]) :-
3292 !.
3293update_facts([H|T], Fact, [Fact|T]) :-
3294 general_pack_fact(Fact, GenFact),
3295 general_pack_fact(H, GenTerm),
3296 GenFact =@= GenTerm,
3297 !.
3298update_facts([H|T0], Fact, [H|T]) :-
3299 update_facts(T0, Fact, T).
3300
3301general_pack_fact(built(Arch, _Version, _How), General) =>
3302 General = built(Arch, _, _).
3303general_pack_fact(Term, General), compound(Term) =>
3304 compound_name_arity(Term, Name, Arity),
3305 compound_name_arity(General, Name, Arity).
3306general_pack_fact(Term, General) =>
3307 General = Term.
3308
(Out) :-
3310 format(Out, '% Fact status file. Managed by package manager.~n', []).
3311
3312write_fact(Out, Term) :-
3313 format(Out, '~q.~n', [Term]).
3314
3320
3321pack_status(Pack, Fact) :-
3322 current_pack(Pack, PackDir),
3323 pack_status_dir(PackDir, Fact).
3324
3325pack_status_dir(PackDir, Fact) :-
3326 det_if(ground(Fact), pack_status_(PackDir, Fact)).
3327
3328pack_status_(PackDir, Fact) :-
3329 status_file(PackDir, StatusFile),
3330 catch(term_in_file(valid_term(pack_status_term), StatusFile, Fact),
3331 error(existence_error(source_sink, StatusFile), _),
3332 fail).
3333
3334pack_status_term(built(atom, version, oneof([built,downloaded]))).
3335pack_status_term(automatic(boolean)).
3336pack_status_term(archive(atom, atom)).
3337
3338
3345
3346update_automatic(Info) :-
3347 _ = Info.get(dependency_for),
3348 \+ pack_status(Info.installed, automatic(_)),
3349 !,
3350 pack_assert(Info.installed, automatic(true)).
3351update_automatic(Info) :-
3352 pack_assert(Info.installed, automatic(false)).
3353
3354status_file(PackDir, StatusFile) :-
3355 directory_file_path(PackDir, 'status.db', StatusFile).
3356
3357 3360
3361:- multifile prolog:message//1. 3362
3364
(_Question, _Alternatives, Default, Selection, Options) :-
3366 option(interactive(false), Options),
3367 !,
3368 Selection = Default.
3369menu(Question, Alternatives, Default, Selection, _) :-
3370 length(Alternatives, N),
3371 between(1, 5, _),
3372 print_message(query, Question),
3373 print_menu(Alternatives, Default, 1),
3374 print_message(query, pack(menu(select))),
3375 read_selection(N, Choice),
3376 !,
3377 ( Choice == default
3378 -> Selection = Default
3379 ; nth1(Choice, Alternatives, Selection=_)
3380 -> true
3381 ).
3382
([], _, _).
3384print_menu([Value=Label|T], Default, I) :-
3385 ( Value == Default
3386 -> print_message(query, pack(menu(default_item(I, Label))))
3387 ; print_message(query, pack(menu(item(I, Label))))
3388 ),
3389 I2 is I + 1,
3390 print_menu(T, Default, I2).
3391
3392read_selection(Max, Choice) :-
3393 get_single_char(Code),
3394 ( answered_default(Code)
3395 -> Choice = default
3396 ; code_type(Code, digit(Choice)),
3397 between(1, Max, Choice)
3398 -> true
3399 ; print_message(warning, pack(menu(reply(1,Max)))),
3400 fail
3401 ).
3402
3408
3409confirm(_Question, Default, Options) :-
3410 Default \== none,
3411 option(interactive(false), Options, true),
3412 !,
3413 Default == yes.
3414confirm(Question, Default, _) :-
3415 between(1, 5, _),
3416 print_message(query, pack(confirm(Question, Default))),
3417 read_yes_no(YesNo, Default),
3418 !,
3419 format(user_error, '~N', []),
3420 YesNo == yes.
3421
3422read_yes_no(YesNo, Default) :-
3423 get_single_char(Code),
3424 code_yes_no(Code, Default, YesNo),
3425 !.
3426
3427code_yes_no(0'y, _, yes).
3428code_yes_no(0'Y, _, yes).
3429code_yes_no(0'n, _, no).
3430code_yes_no(0'N, _, no).
3431code_yes_no(_, none, _) :- !, fail.
3432code_yes_no(C, Default, Default) :-
3433 answered_default(C).
3434
3435answered_default(0'\r).
3436answered_default(0'\n).
3437answered_default(0'\s).
3438
3439
3440 3443
3444:- multifile prolog:message//1. 3445
3446prolog:message(pack(Message)) -->
3447 message(Message).
3448
3449:- discontiguous
3450 message//1,
3451 label//1. 3452
3453message(invalid_term(pack_info_term, Term)) -->
3454 [ 'Invalid package meta data: ~q'-[Term] ].
3455message(invalid_term(pack_status_term, Term)) -->
3456 [ 'Invalid package status data: ~q'-[Term] ].
3457message(directory_exists(Dir)) -->
3458 [ 'Package target directory exists and is not empty:', nl,
3459 '\t~q'-[Dir]
3460 ].
3461message(already_installed(pack(Pack, Version))) -->
3462 [ 'Pack `~w'' is already installed @~w'-[Pack, Version] ].
3463message(already_installed(Pack)) -->
3464 [ 'Pack `~w'' is already installed. Package info:'-[Pack] ].
3465message(kept_foreign(Pack, Arch)) -->
3466 [ 'Found foreign libraries for architecture '-[],
3467 ansi(code, '~q', [Arch]), nl,
3468 'Use ', ansi(code, '?- pack_rebuild(~q).', [Pack]),
3469 ' to rebuild from sources'-[]
3470 ].
3471message(no_pack_installed(Pack)) -->
3472 [ 'No pack ~q installed. Use ?- pack_list(Pattern) to search'-[Pack] ].
3473message(dependency_issues(Issues)) -->
3474 [ 'The current set of packs has dependency issues:', nl ],
3475 dep_issues(Issues).
3476message(depends(Pack, Deps)) -->
3477 [ 'The following packs depend on `~w\':'-[Pack], nl ],
3478 pack_list(Deps).
3479message(remove(PackDir)) -->
3480 [ 'Removing ~q and contents'-[PackDir] ].
3481message(remove_existing_pack(PackDir)) -->
3482 [ 'Remove old installation in ~q'-[PackDir] ].
3483message(download_plan(Plan)) -->
3484 [ ansi(bold, 'Installation plan:', []), nl ],
3485 install_plan(Plan, Actions),
3486 install_label(Actions).
3487message(build_plan(Plan)) -->
3488 [ ansi(bold, 'The following packs have post install scripts:', []), nl ],
3489 msg_build_plan(Plan),
3490 [ nl, ansi(bold, 'Run scripts?', []) ].
3491message(no_meta_data(BaseDir)) -->
3492 [ 'Cannot find pack.pl inside directory ~q. Not a package?'-[BaseDir] ].
3493message(search_no_matches(Name)) -->
3494 [ 'Search for "~w", returned no matching packages'-[Name] ].
3495message(rebuild(Pack)) -->
3496 [ 'Checking pack "~w" for rebuild ...'-[Pack] ].
3497message(up_to_date([Pack])) -->
3498 !,
3499 [ 'Pack ' ], msg_pack(Pack), [' is up-to-date' ].
3500message(up_to_date(Packs)) -->
3501 [ 'Packs ' ], sequence(msg_pack, [', '], Packs), [' are up-to-date' ].
3502message(installed_can_upgrade(List)) -->
3503 sequence(msg_can_upgrade_target, [nl], List).
3504message(new_dependencies(Deps)) -->
3505 [ 'Found new dependencies after downloading (~p).'-[Deps], nl ].
3506message(query_versions(URL)) -->
3507 [ 'Querying "~w" to find new versions ...'-[URL] ].
3508message(no_matching_urls(URL)) -->
3509 [ 'Could not find any matching URL: ~q'-[URL] ].
3510message(found_versions([Latest-_URL|More])) -->
3511 { length(More, Len) },
3512 [ ' Latest version: ~w (~D older)'-[Latest, Len] ].
3513message(build(Pack, PackDir)) -->
3514 [ ansi(bold, 'Building pack ~w in directory ~w', [Pack, PackDir]) ].
3515message(contacting_server(Server)) -->
3516 [ 'Contacting server at ~w ...'-[Server], flush ].
3517message(server_reply(true(_))) -->
3518 [ at_same_line, ' ok'-[] ].
3519message(server_reply(false)) -->
3520 [ at_same_line, ' done'-[] ].
3521message(server_reply(exception(E))) -->
3522 [ 'Server reported the following error:'-[], nl ],
3523 '$messages':translate_message(E).
3524message(cannot_create_dir(Alias)) -->
3525 { findall(PackDir,
3526 absolute_file_name(Alias, PackDir, [solutions(all)]),
3527 PackDirs0),
3528 sort(PackDirs0, PackDirs)
3529 },
3530 [ 'Cannot find a place to create a package directory.'-[],
3531 'Considered:'-[]
3532 ],
3533 candidate_dirs(PackDirs).
3534message(conflict(version, [PackV, FileV])) -->
3535 ['Version mismatch: pack.pl: '-[]], msg_version(PackV),
3536 [', file claims version '-[]], msg_version(FileV).
3537message(conflict(name, [PackInfo, FileInfo])) -->
3538 ['Pack ~w mismatch: pack.pl: ~p'-[PackInfo]],
3539 [', file claims ~w: ~p'-[FileInfo]].
3540message(no_prolog_response(ContentType, String)) -->
3541 [ 'Expected Prolog response. Got content of type ~p'-[ContentType], nl,
3542 '~s'-[String]
3543 ].
3544message(download(begin, Pack, _URL, _DownloadFile)) -->
3545 [ 'Downloading ' ], msg_pack(Pack), [ ' ... ', flush ].
3546message(download(end, _, _, File)) -->
3547 { size_file(File, Bytes) },
3548 [ at_same_line, '~D bytes'-[Bytes] ].
3549message(no_git(URL)) -->
3550 [ 'Cannot install from git repository ', url(URL), '.', nl,
3551 'Cannot find git program and do not know how to download the code', nl,
3552 'from this git service. Please install git and retry.'
3553 ].
3554message(git_no_https(GitURL)) -->
3555 [ 'Do not know how to get an HTTP(s) URL for ', url(GitURL) ].
3556message(git_branch_not_default(Dir, Default, Current)) -->
3557 [ 'GIT current branch on ', url(Dir), ' is not default.', nl,
3558 ' Current branch: ', ansi(code, '~w', [Current]),
3559 ' default: ', ansi(code, '~w', [Default])
3560 ].
3561message(git_not_clean(Dir)) -->
3562 [ 'GIT working directory is dirty: ', url(Dir), nl,
3563 'Your repository must be clean before publishing.'
3564 ].
3565message(git_push) -->
3566 [ 'Push release to GIT origin?' ].
3567message(git_tag(Tag)) -->
3568 [ 'Tag repository with release tag ', ansi(code, '~w', [Tag]) ].
3569message(git_release_tag_not_at_head(Tag)) -->
3570 [ 'Release tag ', ansi(code, '~w', [Tag]), ' is not at HEAD.', nl,
3571 'If you want to update the tag, please run ',
3572 ansi(code, 'git tag -d ~w', [Tag])
3573 ].
3574message(git_tag_out_of_sync(Tag)) -->
3575 [ 'Release tag ', ansi(code, '~w', [Tag]),
3576 ' differs from this tag at the origin'
3577 ].
3578
3579message(published(Info, At)) -->
3580 [ 'Published pack ' ], msg_pack(Info), msg_info_version(Info),
3581 [' to be installed from '],
3582 msg_published_address(At).
3583message(publish_failed(Info, Reason)) -->
3584 [ 'Pack ' ], msg_pack(Info), [ ' at version ~w'-[Info.version] ],
3585 msg_publish_failed(Reason).
3586
3587msg_publish_failed(throw(error(permission_error(register,
3588 pack(_),_URL),_))) -->
3589 [ ' is already registered with a different URL'].
3590msg_publish_failed(download) -->
3591 [' was already published?'].
3592msg_publish_failed(Status) -->
3593 [ ' failed for unknown reason (~p)'-[Status] ].
3594
3595msg_published_address(git(URL)) -->
3596 msg_url(URL, _).
3597msg_published_address(file(URL)) -->
3598 msg_url(URL, _).
3599
3600candidate_dirs([]) --> [].
3601candidate_dirs([H|T]) --> [ nl, ' ~w'-[H] ], candidate_dirs(T).
3602 3603message(resolve_remove) -->
3604 [ nl, 'Please select an action:', nl, nl ].
3605message(create_pack_dir) -->
3606 [ nl, 'Create directory for packages', nl ].
3607message(menu(item(I, Label))) -->
3608 [ '~t(~d)~6| '-[I] ],
3609 label(Label).
3610message(menu(default_item(I, Label))) -->
3611 [ '~t(~d)~6| * '-[I] ],
3612 label(Label).
3613message(menu(select)) -->
3614 [ nl, 'Your choice? ', flush ].
3615message(confirm(Question, Default)) -->
3616 message(Question),
3617 confirm_default(Default),
3618 [ flush ].
3619message(menu(reply(Min,Max))) -->
3620 ( { Max =:= Min+1 }
3621 -> [ 'Please enter ~w or ~w'-[Min,Max] ]
3622 ; [ 'Please enter a number between ~w and ~w'-[Min,Max] ]
3623 ).
3624
3625 3626dep_issues(Issues) -->
3627 sequence(dep_issue, [nl], Issues).
3628
3629dep_issue(unsatisfied(Pack, Requires)) -->
3630 [ ' - Pack ' ], msg_pack(Pack), [' requires ~p'-[Requires]].
3631dep_issue(conflicts(Pack, Conflict)) -->
3632 [ ' - Pack ' ], msg_pack(Pack), [' conflicts with ~p'-[Conflict]].
3633
3638
3639install_label([link]) -->
3640 !,
3641 [ ansi(bold, 'Activate pack?', []) ].
3642install_label([unpack]) -->
3643 !,
3644 [ ansi(bold, 'Unpack archive?', []) ].
3645install_label(_) -->
3646 [ ansi(bold, 'Download packs?', []) ].
3647
3648
3649install_plan(Plan, Actions) -->
3650 install_plan(Plan, Actions, Sec),
3651 sec_warning(Sec).
3652
3653install_plan([], [], _) -->
3654 [].
3655install_plan([H|T], [AH|AT], Sec) -->
3656 install_step(H, AH, Sec), [nl],
3657 install_plan(T, AT, Sec).
3658
3659install_step(Info, keep, _Sec) -->
3660 { Info.get(keep) == true },
3661 !,
3662 [ ' Keep ' ], msg_pack(Info), [ ' at version ~w'-[Info.version] ],
3663 msg_can_upgrade(Info).
3664install_step(Info, Action, Sec) -->
3665 { From = Info.get(upgrade),
3666 VFrom = From.version,
3667 VTo = Info.get(version),
3668 ( cmp_versions(>=, VTo, VFrom)
3669 -> Label = ansi(bold, ' Upgrade ', [])
3670 ; Label = ansi(warning, ' Downgrade ', [])
3671 )
3672 },
3673 [ Label ], msg_pack(Info),
3674 [ ' from version ~w to ~w'- [From.version, Info.get(version)] ],
3675 install_from(Info, Action, Sec).
3676install_step(Info, Action, Sec) -->
3677 { _From = Info.get(upgrade) },
3678 [ ' Upgrade ' ], msg_pack(Info),
3679 install_from(Info, Action, Sec).
3680install_step(Info, Action, Sec) -->
3681 { Dep = Info.get(dependency_for) },
3682 [ ' Install ' ], msg_pack(Info),
3683 [ ' at version ~w as dependency for '-[Info.version],
3684 ansi(code, '~w', [Dep])
3685 ],
3686 install_from(Info, Action, Sec),
3687 msg_downloads(Info).
3688install_step(Info, Action, Sec) -->
3689 { Info.get(commit) == 'HEAD' },
3690 !,
3691 [ ' Install ' ], msg_pack(Info), [ ' at current GIT HEAD'-[] ],
3692 install_from(Info, Action, Sec),
3693 msg_downloads(Info).
3694install_step(Info, link, _Sec) -->
3695 { Info.get(link) == true,
3696 uri_file_name(Info.get(url), Dir)
3697 },
3698 !,
3699 [ ' Install ' ], msg_pack(Info), [ ' as symlink to ', url(Dir) ].
3700install_step(Info, Action, Sec) -->
3701 [ ' Install ' ], msg_pack(Info), [ ' at version ~w'-[Info.get(version)] ],
3702 install_from(Info, Action, Sec),
3703 msg_downloads(Info).
3704install_step(Info, Action, Sec) -->
3705 [ ' Install ' ], msg_pack(Info),
3706 install_from(Info, Action, Sec),
3707 msg_downloads(Info).
3708
3709install_from(Info, download, Sec) -->
3710 { download_url(Info.url) },
3711 !,
3712 [ ' from ' ], msg_url(Info.url, Sec).
3713install_from(Info, unpack, Sec) -->
3714 [ ' from ' ], msg_url(Info.url, Sec).
3715
3716msg_url(URL, unsafe) -->
3717 { atomic(URL),
3718 atom_concat('http://', Rest, URL)
3719 },
3720 [ ansi(error, '~w', ['http://']), '~w'-[Rest] ].
3721msg_url(URL, _) -->
3722 [ url(URL) ].
3723
3724sec_warning(Sec) -->
3725 { var(Sec) },
3726 !.
3727sec_warning(unsafe) -->
3728 [ ansi(warning, ' WARNING: The installation plan includes downloads \c
3729 from insecure HTTP servers.', []), nl
3730 ].
3731
3732msg_downloads(Info) -->
3733 { Downloads = Info.get(all_downloads),
3734 Downloads > 0
3735 },
3736 [ ansi(comment, ' (downloaded ~D times)', [Downloads]) ],
3737 !.
3738msg_downloads(_) -->
3739 [].
3740
3741msg_pack(Pack) -->
3742 { atom(Pack) },
3743 !,
3744 [ ansi(code, '~w', [Pack]) ].
3745msg_pack(Info) -->
3746 msg_pack(Info.pack).
3747
3748msg_info_version(Info) -->
3749 [ ansi(code, '@~w', [Info.get(version)]) ],
3750 !.
3751msg_info_version(_Info) -->
3752 [].
3753
3757
3758msg_build_plan(Plan) -->
3759 sequence(build_step, [nl], Plan).
3760
3761build_step(Info) -->
3762 [ ' Build ' ], msg_pack(Info), [' in directory ', url(Info.installed) ].
3763
3764msg_can_upgrade_target(Info) -->
3765 [ ' Pack ' ], msg_pack(Info),
3766 [ ' is installed at version ~w'-[Info.version] ],
3767 msg_can_upgrade(Info).
3768
3769pack_list([]) --> [].
3770pack_list([H|T]) -->
3771 [ ' - Pack ' ], msg_pack(H), [nl],
3772 pack_list(T).
3773
3774label(remove_only(Pack)) -->
3775 [ 'Only remove package ~w (break dependencies)'-[Pack] ].
3776label(remove_deps(Pack, Deps)) -->
3777 { length(Deps, Count) },
3778 [ 'Remove package ~w and ~D dependencies'-[Pack, Count] ].
3779label(create_dir(Dir)) -->
3780 [ '~w'-[Dir] ].
3781label(install_from(git(URL))) -->
3782 !,
3783 [ 'GIT repository at ~w'-[URL] ].
3784label(install_from(URL)) -->
3785 [ '~w'-[URL] ].
3786label(cancel) -->
3787 [ 'Cancel' ].
3788
3789confirm_default(yes) -->
3790 [ ' Y/n? ' ].
3791confirm_default(no) -->
3792 [ ' y/N? ' ].
3793confirm_default(none) -->
3794 [ ' y/n? ' ].
3795
3796msg_version(Version) -->
3797 [ '~w'-[Version] ].
3798
3799msg_can_upgrade(Info) -->
3800 { Latest = Info.get(latest_version) },
3801 [ ansi(warning, ' (can be upgraded to ~w)', [Latest]) ].
3802msg_can_upgrade(_) -->
3803 [].
3804
3805
3806 3809
3810local_uri_file_name(URL, FileName) :-
3811 uri_file_name(URL, FileName),
3812 !.
3813local_uri_file_name(URL, FileName) :-
3814 uri_components(URL, Components),
3815 uri_data(scheme, Components, File), File == file,
3816 uri_data(authority, Components, FileNameEnc),
3817 uri_data(path, Components, ''),
3818 uri_encoded(path, FileName, FileNameEnc).
3819
3820det_if(Cond, Goal) :-
3821 ( Cond
3822 -> Goal,
3823 !
3824 ; Goal
3825 ).
3826
3827member_nonvar(_, Var) :-
3828 var(Var),
3829 !,
3830 fail.
3831member_nonvar(E, [E|_]).
3832member_nonvar(E, [_|T]) :-
3833 member_nonvar(E, T)