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), [pairs_keys/2]). 70:- autoload(library(git)). 71:- autoload(library(sgml)). 72:- autoload(library(sha)). 73:- autoload(library(build/tools)). 74:- autoload(library(ansi_term), [ansi_format/3]). 75:- autoload(library(pprint), [print_term/2]). 76:- autoload(library(prolog_versions), [require_version/3, cmp_versions/3]). 77:- autoload(library(ugraphs), [vertices_edges_to_ugraph/3, ugraph_layers/2]). 78:- autoload(library(process), [process_which/2]). 79
80:- meta_predicate
81 pack_install_local(2, +, +). 82
95
96 99
100:- setting(server, atom, 'https://www.swi-prolog.org/pack/',
101 'Server to exchange pack information'). 102
103
104 107
108:- op(900, xfx, @). 109
110:- meta_predicate det_if(0,0). 111
112 115
120
121current_pack(Pack) :-
122 current_pack(Pack, _).
123
124current_pack(Pack, Dir) :-
125 '$pack':pack(Pack, Dir).
126
131
132pack_list_installed :-
133 pack_list('', [installed(true)]),
134 validate_dependencies.
135
139
140pack_info(Name) :-
141 pack_info(info, Name).
142
143pack_info(Level, Name) :-
144 must_be(atom, Name),
145 findall(Info, pack_info(Name, Level, Info), Infos0),
146 ( Infos0 == []
147 -> print_message(warning, pack(no_pack_installed(Name))),
148 fail
149 ; true
150 ),
151 findall(Def, pack_default(Level, Infos, Def), Defs),
152 append(Infos0, Defs, Infos1),
153 sort(Infos1, Infos),
154 show_info(Name, Infos, [info(Level)]).
155
156
157show_info(_Name, _Properties, Options) :-
158 option(silent(true), Options),
159 !.
160show_info(_Name, _Properties, Options) :-
161 option(show_info(false), Options),
162 !.
163show_info(Name, Properties, Options) :-
164 option(info(list), Options),
165 !,
166 memberchk(title(Title), Properties),
167 memberchk(version(Version), Properties),
168 format('i ~w@~w ~28|- ~w~n', [Name, Version, Title]).
169show_info(Name, Properties, _) :-
170 !,
171 print_property_value('Package'-'~w', [Name]),
172 findall(Term, pack_level_info(info, Term, _, _), Terms),
173 maplist(print_property(Properties), Terms).
174
175print_property(_, nl) :-
176 !,
177 format('~n').
178print_property(Properties, Term) :-
179 findall(Term, member(Term, Properties), Terms),
180 Terms \== [],
181 !,
182 pack_level_info(_, Term, LabelFmt, _Def),
183 ( LabelFmt = Label-FmtElem
184 -> true
185 ; Label = LabelFmt,
186 FmtElem = '~w'
187 ),
188 multi_valued(Terms, FmtElem, FmtList, Values),
189 atomic_list_concat(FmtList, ', ', Fmt),
190 print_property_value(Label-Fmt, Values).
191print_property(_, _).
192
193multi_valued([H], LabelFmt, [LabelFmt], Values) :-
194 !,
195 H =.. [_|Values].
196multi_valued([H|T], LabelFmt, [LabelFmt|LT], Values) :-
197 H =.. [_|VH],
198 append(VH, MoreValues, Values),
199 multi_valued(T, LabelFmt, LT, MoreValues).
200
201
202pvalue_column(29).
203print_property_value(Prop-Fmt, Values) :-
204 !,
205 pvalue_column(C),
206 atomic_list_concat(['~w:~t~*|', Fmt, '~n'], Format),
207 format(Format, [Prop,C|Values]).
208
209pack_info(Name, Level, Info) :-
210 '$pack':pack(Name, BaseDir),
211 pack_dir_info(BaseDir, Level, Info).
212
213pack_dir_info(BaseDir, Level, Info) :-
214 ( Info = directory(BaseDir)
215 ; pack_info_term(BaseDir, Info)
216 ),
217 pack_level_info(Level, Info, _Format, _Default).
218
219:- public pack_level_info/4. 220
221pack_level_info(_, title(_), 'Title', '<no title>').
222pack_level_info(_, version(_), 'Installed version', '<unknown>').
223pack_level_info(info, automatic(_), 'Automatic (dependency only)', -).
224pack_level_info(info, directory(_), 'Installed in directory', -).
225pack_level_info(info, link(_), 'Installed as link to'-'~w', -).
226pack_level_info(info, built(_,_), 'Built on'-'~w for SWI-Prolog ~w', -).
227pack_level_info(info, author(_, _), 'Author'-'~w <~w>', -).
228pack_level_info(info, maintainer(_, _), 'Maintainer'-'~w <~w>', -).
229pack_level_info(info, packager(_, _), 'Packager'-'~w <~w>', -).
230pack_level_info(info, home(_), 'Home page', -).
231pack_level_info(info, download(_), 'Download URL', -).
232pack_level_info(_, provides(_), 'Provides', -).
233pack_level_info(_, requires(_), 'Requires', -).
234pack_level_info(_, conflicts(_), 'Conflicts with', -).
235pack_level_info(_, replaces(_), 'Replaces packages', -).
236pack_level_info(info, library(_), 'Provided libraries', -).
237
238pack_default(Level, Infos, Def) :-
239 pack_level_info(Level, ITerm, _Format, Def),
240 Def \== (-),
241 \+ memberchk(ITerm, Infos).
242
246
247pack_info_term(BaseDir, Info) :-
248 directory_file_path(BaseDir, 'pack.pl', InfoFile),
249 catch(
250 term_in_file(valid_term(pack_info_term), InfoFile, Info),
251 error(existence_error(source_sink, InfoFile), _),
252 ( print_message(error, pack(no_meta_data(BaseDir))),
253 fail
254 )).
255pack_info_term(BaseDir, library(Lib)) :-
256 atom_concat(BaseDir, '/prolog/', LibDir),
257 atom_concat(LibDir, '*.pl', Pattern),
258 expand_file_name(Pattern, Files),
259 maplist(atom_concat(LibDir), Plain, Files),
260 convlist(base_name, Plain, Libs),
261 member(Lib, Libs).
262pack_info_term(BaseDir, automatic(Boolean)) :-
263 once(pack_status_dir(BaseDir, automatic(Boolean))).
264pack_info_term(BaseDir, built(Arch, Prolog)) :-
265 pack_status_dir(BaseDir, built(Arch, Prolog, _How)).
266pack_info_term(BaseDir, link(Dest)) :-
267 read_link(BaseDir, _, Dest).
268
269base_name(File, Base) :-
270 file_name_extension(Base, pl, File).
271
275
276:- meta_predicate
277 term_in_file(1, +, -). 278
279term_in_file(Valid, File, Term) :-
280 exists_file(File),
281 setup_call_cleanup(
282 open(File, read, In, [encoding(utf8)]),
283 term_in_stream(Valid, In, Term),
284 close(In)).
285
286term_in_stream(Valid, In, Term) :-
287 repeat,
288 read_term(In, Term0, []),
289 ( Term0 == end_of_file
290 -> !, fail
291 ; Term = Term0,
292 call(Valid, Term0)
293 ).
294
295:- meta_predicate
296 valid_term(1,+). 297
298valid_term(Type, Term) :-
299 Term =.. [Name|Args],
300 same_length(Args, Types),
301 Decl =.. [Name|Types],
302 ( call(Type, Decl)
303 -> maplist(valid_info_arg, Types, Args)
304 ; print_message(warning, pack(invalid_term(Type, Term))),
305 fail
306 ).
307
308valid_info_arg(Type, Arg) :-
309 must_be(Type, Arg).
310
315
316pack_info_term(name(atom)). 317pack_info_term(title(atom)).
318pack_info_term(keywords(list(atom))).
319pack_info_term(description(list(atom))).
320pack_info_term(version(version)).
321pack_info_term(author(atom, email_or_url_or_empty)). 322pack_info_term(maintainer(atom, email_or_url)).
323pack_info_term(packager(atom, email_or_url)).
324pack_info_term(pack_version(nonneg)). 325pack_info_term(home(atom)). 326pack_info_term(download(atom)). 327pack_info_term(provides(atom)). 328pack_info_term(requires(dependency)).
329pack_info_term(conflicts(dependency)). 330pack_info_term(replaces(atom)). 331pack_info_term(autoload(boolean)). 332
333:- multifile
334 error:has_type/2. 335
336error:has_type(version, Version) :-
337 atom(Version),
338 is_version(Version).
339error:has_type(email_or_url, Address) :-
340 atom(Address),
341 ( sub_atom(Address, _, _, _, @)
342 -> true
343 ; uri_is_global(Address)
344 ).
345error:has_type(email_or_url_or_empty, Address) :-
346 ( Address == ''
347 -> true
348 ; error:has_type(email_or_url, Address)
349 ).
350error:has_type(dependency, Value) :-
351 is_dependency(Value, _Token, _Version).
352
353is_version(Version) :-
354 split_string(Version, ".", "", Parts),
355 maplist(number_string, _, Parts).
356
357is_dependency(Token, Token, *) :-
358 atom(Token).
359is_dependency(Term, Token, VersionCmp) :-
360 Term =.. [Op,Token,Version],
361 cmp(Op, _),
362 is_version(Version),
363 VersionCmp =.. [Op,Version].
364
365cmp(<, @<).
366cmp(=<, @=<).
367cmp(==, ==).
368cmp(>=, @>=).
369cmp(>, @>).
370
371
372 375
415
416pack_list(Query) :-
417 pack_list(Query, []).
418
419pack_search(Query) :-
420 pack_list(Query, []).
421
422pack_list(Query, Options) :-
423 ( option(installed(true), Options)
424 ; option(outdated(true), Options)
425 ; option(server(false), Options)
426 ),
427 !,
428 local_search(Query, Local),
429 maplist(arg(1), Local, Packs),
430 ( option(server(false), Options)
431 -> Hits = []
432 ; query_pack_server(info(Packs), true(Hits), Options)
433 ),
434 list_hits(Hits, Local, Options).
435pack_list(Query, Options) :-
436 query_pack_server(search(Query), Result, Options),
437 ( Result == false
438 -> ( local_search(Query, Packs),
439 Packs \== []
440 -> forall(member(pack(Pack, Stat, Title, Version, _), Packs),
441 format('~w ~w@~w ~28|- ~w~n',
442 [Stat, Pack, Version, Title]))
443 ; print_message(warning, pack(search_no_matches(Query)))
444 )
445 ; Result = true(Hits), 446 local_search(Query, Local),
447 list_hits(Hits, Local, [])
448 ).
449
450list_hits(Hits, Local, Options) :-
451 append(Hits, Local, All),
452 sort(All, Sorted),
453 join_status(Sorted, Packs0),
454 include(filtered(Options), Packs0, Packs),
455 maplist(list_hit(Options), Packs).
456
457filtered(Options, pack(_,Tag,_,_,_)) :-
458 option(outdated(true), Options),
459 !,
460 Tag == 'U'.
461filtered(_, _).
462
463list_hit(_Options, pack(Pack, Tag, Title, Version, _URL)) =>
464 list_tag(Tag),
465 ansi_format(code, '~w', [Pack]),
466 format('@'),
467 list_version(Tag, Version),
468 format('~35|- ', []),
469 ansi_format(comment, '~w~n', [Title]).
470
471list_tag(Tag) :-
472 tag_color(Tag, Color),
473 ansi_format(Color, '~w ', [Tag]).
474
475list_version(Tag, VersionI-VersionS) =>
476 tag_color(Tag, Color),
477 ansi_format(Color, '~w', [VersionI]),
478 ansi_format(bold, '(~w)', [VersionS]).
479list_version(_Tag, Version) =>
480 ansi_format([], '~w', [Version]).
481
482tag_color('U', warning) :- !.
483tag_color('A', comment) :- !.
484tag_color(_, []).
485
492
493join_status([], []).
494join_status([ pack(Pack, i, Title, Version, URL),
495 pack(Pack, p, Title, Version, _)
496 | T0
497 ],
498 [ pack(Pack, Tag, Title, Version, URL)
499 | T
500 ]) :-
501 !,
502 ( pack_status(Pack, automatic(true))
503 -> Tag = a
504 ; Tag = i
505 ),
506 join_status(T0, T).
507join_status([ pack(Pack, i, Title, VersionI, URLI),
508 pack(Pack, p, _, VersionS, URLS)
509 | T0
510 ],
511 [ pack(Pack, Tag, Title, VersionI-VersionS, URLI-URLS)
512 | T
513 ]) :-
514 !,
515 version_sort_key(VersionI, VDI),
516 version_sort_key(VersionS, VDS),
517 ( VDI @< VDS
518 -> Tag = 'U'
519 ; Tag = 'A'
520 ),
521 join_status(T0, T).
522join_status([ pack(Pack, i, Title, VersionI, URL)
523 | T0
524 ],
525 [ pack(Pack, l, Title, VersionI, URL)
526 | T
527 ]) :-
528 !,
529 join_status(T0, T).
530join_status([H|T0], [H|T]) :-
531 join_status(T0, T).
532
536
537local_search(Query, Packs) :-
538 findall(Pack, matching_installed_pack(Query, Pack), Packs).
539
540matching_installed_pack(Query, pack(Pack, i, Title, Version, URL)) :-
541 current_pack(Pack),
542 findall(Term,
543 ( pack_info(Pack, _, Term),
544 search_info(Term)
545 ), Info),
546 ( sub_atom_icasechk(Pack, _, Query)
547 -> true
548 ; memberchk(title(Title), Info),
549 sub_atom_icasechk(Title, _, Query)
550 ),
551 option(title(Title), Info, '<no title>'),
552 option(version(Version), Info, '<no version>'),
553 option(download(URL), Info, '<no download url>').
554
555search_info(title(_)).
556search_info(version(_)).
557search_info(download(_)).
558
559
560 563
661
662pack_install(Spec) :-
663 pack_default_options(Spec, Pack, [], Options),
664 pack_install(Pack, [pack(Pack)|Options]).
665
666pack_install(Specs, Options) :-
667 is_list(Specs),
668 !,
669 maplist(pack_options(Options), Specs, Pairs),
670 pack_install_dir(PackTopDir, Options),
671 pack_install_set(Pairs, PackTopDir, Options).
672pack_install(Spec, Options) :-
673 pack_default_options(Spec, Pack, Options, DefOptions),
674 ( option(already_installed(Installed), DefOptions)
675 -> print_message(informational, pack(already_installed(Installed)))
676 ; merge_options(Options, DefOptions, PackOptions),
677 pack_install_dir(PackTopDir, PackOptions),
678 pack_install_set([Pack-PackOptions], PackTopDir, Options)
679 ).
680
681pack_options(Options, Spec, Pack-PackOptions) :-
682 pack_default_options(Spec, Pack, Options, DefOptions),
683 merge_options(Options, DefOptions, PackOptions).
684
707
708
709pack_default_options(_Spec, Pack, OptsIn, Options) :- 710 option(already_installed(pack(Pack,_Version)), OptsIn),
711 !,
712 Options = OptsIn.
713pack_default_options(_Spec, Pack, OptsIn, Options) :- 714 option(url(URL), OptsIn),
715 !,
716 ( option(git(_), OptsIn)
717 -> Options = OptsIn
718 ; git_url(URL, Pack)
719 -> Options = [git(true)|OptsIn]
720 ; Options = OptsIn
721 ),
722 ( nonvar(Pack)
723 -> true
724 ; option(pack(Pack), Options)
725 -> true
726 ; pack_version_file(Pack, _Version, URL)
727 ).
728pack_default_options(Archive, Pack, OptsIn, Options) :- 729 must_be(atom, Archive),
730 \+ uri_is_global(Archive),
731 expand_file_name(Archive, [File]),
732 exists_file(File),
733 !,
734 ( pack_version_file(Pack, Version, File)
735 -> uri_file_name(FileURL, File),
736 merge_options([url(FileURL), version(Version)], OptsIn, Options)
737 ; domain_error(pack_file_name, Archive)
738 ).
739pack_default_options(URL, Pack, OptsIn, Options) :- 740 git_url(URL, Pack),
741 !,
742 merge_options([git(true), url(URL)], OptsIn, Options).
743pack_default_options(FileURL, Pack, _, Options) :- 744 uri_file_name(FileURL, Dir),
745 exists_directory(Dir),
746 pack_info_term(Dir, name(Pack)),
747 !,
748 ( pack_info_term(Dir, version(Version))
749 -> uri_file_name(DirURL, Dir),
750 Options = [url(DirURL), version(Version)]
751 ; throw(error(existence_error(key, version, Dir),_))
752 ).
753pack_default_options('.', Pack, OptsIn, Options) :- 754 pack_info_term('.', name(Pack)),
755 !,
756 working_directory(Dir, Dir),
757 ( pack_info_term(Dir, version(Version))
758 -> uri_file_name(DirURL, Dir),
759 NewOptions = [url(DirURL), version(Version) | Options1],
760 ( current_prolog_flag(windows, true)
761 -> Options1 = []
762 ; Options1 = [link(true), rebuild(make)]
763 ),
764 merge_options(NewOptions, OptsIn, Options)
765 ; throw(error(existence_error(key, version, Dir),_))
766 ).
767pack_default_options(URL, Pack, OptsIn, Options) :- 768 pack_version_file(Pack, Version, URL),
769 download_url(URL),
770 !,
771 available_download_versions(URL, Available),
772 Available = [URLVersion-LatestURL|_],
773 NewOptions = [url(LatestURL)|VersionOptions],
774 version_options(Version, URLVersion, Available, VersionOptions),
775 merge_options(NewOptions, OptsIn, Options).
776pack_default_options(Pack, Pack, Options, Options) :- 777 \+ uri_is_global(Pack).
778
779version_options(Version, Version, _, [version(Version)]) :- !.
780version_options(Version, _, Available, [versions(Available)]) :-
781 sub_atom(Version, _, _, _, *),
782 !.
783version_options(_, _, _, []).
784
802
803pack_install_dir(PackDir, Options) :-
804 option(pack_directory(PackDir), Options),
805 ensure_directory(PackDir),
806 !.
807pack_install_dir(PackDir, Options) :-
808 base_alias(Alias, Options),
809 absolute_file_name(Alias, PackDir,
810 [ file_type(directory),
811 access(write),
812 file_errors(fail)
813 ]),
814 !.
815pack_install_dir(PackDir, Options) :-
816 pack_create_install_dir(PackDir, Options).
817
818base_alias(Alias, Options) :-
819 option(global(true), Options),
820 !,
821 Alias = common_app_data(pack).
822base_alias(Alias, Options) :-
823 option(global(false), Options),
824 !,
825 Alias = user_app_data(pack).
826base_alias(Alias, _Options) :-
827 Alias = pack('.').
828
829pack_create_install_dir(PackDir, Options) :-
830 base_alias(Alias, Options),
831 findall(Candidate = create_dir(Candidate),
832 ( absolute_file_name(Alias, Candidate, [solutions(all)]),
833 \+ exists_file(Candidate),
834 \+ exists_directory(Candidate),
835 file_directory_name(Candidate, Super),
836 ( exists_directory(Super)
837 -> access_file(Super, write)
838 ; true
839 )
840 ),
841 Candidates0),
842 list_to_set(Candidates0, Candidates), 843 pack_create_install_dir(Candidates, PackDir, Options).
844
845pack_create_install_dir(Candidates, PackDir, Options) :-
846 Candidates = [Default=_|_],
847 !,
848 append(Candidates, [cancel=cancel], Menu),
849 menu(pack(create_pack_dir), Menu, Default, Selected, Options),
850 Selected \== cancel,
851 ( catch(make_directory_path(Selected), E,
852 (print_message(warning, E), fail))
853 -> PackDir = Selected
854 ; delete(Candidates, PackDir=create_dir(PackDir), Remaining),
855 pack_create_install_dir(Remaining, PackDir, Options)
856 ).
857pack_create_install_dir(_, _, _) :-
858 print_message(error, pack(cannot_create_dir(pack(.)))),
859 fail.
860
872
873pack_unpack_from_local(Source, PackTopDir, Name, PackDir, Options) :-
874 exists_directory(Source),
875 !,
876 directory_file_path(PackTopDir, Name, PackDir),
877 ( option(link(true), Options)
878 -> ( same_file(Source, PackDir)
879 -> true
880 ; remove_existing_pack(PackDir, Options),
881 atom_concat(PackTopDir, '/', PackTopDirS),
882 relative_file_name(Source, PackTopDirS, RelPath),
883 link_file(RelPath, PackDir, symbolic),
884 assertion(same_file(Source, PackDir))
885 )
886 ; is_git_directory(Source)
887 -> remove_existing_pack(PackDir, Options),
888 run_process(path(git), [clone, Source, PackDir], [])
889 ; prepare_pack_dir(PackDir, Options),
890 copy_directory(Source, PackDir)
891 ).
892pack_unpack_from_local(Source, PackTopDir, Name, PackDir, Options) :-
893 exists_file(Source),
894 directory_file_path(PackTopDir, Name, PackDir),
895 prepare_pack_dir(PackDir, Options),
896 pack_unpack(Source, PackDir, Name, Options).
897
904
905:- if(exists_source(library(archive))). 906pack_unpack(Source, PackDir, Pack, Options) :-
907 ensure_loaded_archive,
908 pack_archive_info(Source, Pack, _Info, StripOptions),
909 prepare_pack_dir(PackDir, Options),
910 archive_extract(Source, PackDir,
911 [ exclude(['._*']) 912 | StripOptions
913 ]).
914:- else. 915pack_unpack(_,_,_,_) :-
916 existence_error(library, archive).
917:- endif. 918
924
925pack_install_local(M:Gen, Dir, Options) :-
926 findall(Pack-PackOptions, call(M:Gen, Pack, PackOptions), Pairs),
927 pack_install_set(Pairs, Dir, Options).
928
929pack_install_set(Pairs, Dir, Options) :-
930 must_be(list(pair), Pairs),
931 ensure_directory(Dir),
932 partition(known_media, Pairs, Local, Remote),
933 maplist(pack_options_to_versions, Local, LocalVersions),
934 ( Remote == []
935 -> AllVersions = LocalVersions
936 ; pairs_keys(Remote, Packs),
937 prolog_description(Properties),
938 query_pack_server(versions(Packs, Properties), Result, Options),
939 ( Result = true(RemoteVersions)
940 -> append(LocalVersions, RemoteVersions, AllVersions)
941 ; print_message(error, pack(query_failed(Result))),
942 fail
943 )
944 ),
945 local_packs(Dir, Existing),
946 pack_resolve(Pairs, Existing, AllVersions, Plan, Options),
947 !, 948 Options1 = [pack_directory(Dir)|Options],
949 download_plan(Pairs, Plan, PlanB, Options1),
950 register_downloads(PlanB, Options),
951 maplist(update_automatic, PlanB),
952 build_plan(PlanB, Built, Options1),
953 publish_download(PlanB, Options),
954 work_done(Pairs, Plan, PlanB, Built, Options).
955
962
963known_media(_-Options) :-
964 option(url(_), Options).
965
981
982pack_resolve(Pairs, Existing, Versions, Plan, Options) :-
983 insert_existing(Existing, Versions, AllVersions, Options),
984 phrase(select_version(Pairs, AllVersions,
985 [ plan(PlanA), 986 dependency_for([]) 987 | Options
988 ]),
989 PlanA),
990 mark_installed(PlanA, Existing, Plan).
991
1000
1001:- det(insert_existing/4). 1002insert_existing(Existing, [], Versions, _Options) =>
1003 maplist(existing_to_versions, Existing, Versions).
1004insert_existing(Existing, [Pack-Versions|T0], AllPackVersions, Options),
1005 select(Installed, Existing, Existing2),
1006 Installed.pack == Pack =>
1007 can_upgrade(Installed, Versions, Installed2),
1008 insert_existing_(Installed2, Versions, AllVersions, Options),
1009 AllPackVersions = [Pack-AllVersions|T],
1010 insert_existing(Existing2, T0, T, Options).
1011insert_existing(Existing, [H|T0], AllVersions, Options) =>
1012 AllVersions = [H|T],
1013 insert_existing(Existing, T0, T, Options).
1014
1015existing_to_versions(Installed, Pack-[Version-[Installed]]) :-
1016 Pack = Installed.pack,
1017 Version = Installed.version.
1018
1019insert_existing_(Installed, Versions, AllVersions, Options) :-
1020 option(upgrade(true), Options),
1021 !,
1022 insert_existing_(Installed, Versions, AllVersions).
1023insert_existing_(Installed, Versions, AllVersions, _) :-
1024 AllVersions = [Installed.version-[Installed]|Versions].
1025
1026insert_existing_(Installed, [H|T0], [H|T]) :-
1027 H = V0-_Infos,
1028 cmp_versions(>, V0, Installed.version),
1029 !,
1030 insert_existing_(Installed, T0, T).
1031insert_existing_(Installed, [H0|T], [H|T]) :-
1032 H0 = V0-Infos,
1033 V0 == Installed.version,
1034 !,
1035 H = V0-[Installed|Infos].
1036insert_existing_(Installed, Versions, All) :-
1037 All = [Installed.version-[Installed]|Versions].
1038
1043
1044can_upgrade(Info, [Version-_|_], Info2) :-
1045 cmp_versions(>, Version, Info.version),
1046 !,
1047 Info2 = Info.put(latest_version, Version).
1048can_upgrade(Info, _, Info).
1049
1055
1056mark_installed([], _, []).
1057mark_installed([Info|T], Existing, Plan) :-
1058 ( member(Installed, Existing),
1059 Installed.pack == Info.pack
1060 -> ( ( Installed.git == true
1061 -> Info.git == true,
1062 Installed.hash == Info.hash
1063 ; Version = Info.get(version)
1064 -> Installed.version == Version
1065 )
1066 -> Plan = [Info.put(keep, true)|PlanT] 1067 ; Plan = [Info.put(upgrade, Installed)|PlanT] 1068 )
1069 ; Plan = [Info|PlanT] 1070 ),
1071 mark_installed(T, Existing, PlanT).
1072
1078
1079select_version([], _, _) -->
1080 [].
1081select_version([Pack-PackOptions|More], Versions, Options) -->
1082 { memberchk(Pack-PackVersions, Versions),
1083 member(Version-Infos, PackVersions),
1084 compatible_version(Pack, Version, PackOptions),
1085 member(Info, Infos),
1086 pack_options_compatible_with_info(Info, PackOptions),
1087 pack_satisfies(Pack, Version, Info, Info2, PackOptions),
1088 all_downloads(PackVersions, Downloads)
1089 },
1090 add_to_plan(Info2.put(_{version: Version, all_downloads:Downloads}),
1091 Versions, Options),
1092 select_version(More, Versions, Options).
1093select_version([Pack-_PackOptions|_More], _Versions, _Options) -->
1094 { existence_error(pack, Pack) }. 1095
1096all_downloads(PackVersions, AllDownloads) :-
1097 aggregate_all(sum(Downloads),
1098 ( member(_Version-Infos, PackVersions),
1099 member(Info, Infos),
1100 get_dict(downloads, Info, Downloads)
1101 ),
1102 AllDownloads).
1103
1104add_requirements([], _, _) -->
1105 [].
1106add_requirements([H|T], Versions, Options) -->
1107 { is_prolog_token(H),
1108 !,
1109 prolog_satisfies(H)
1110 },
1111 add_requirements(T, Versions, Options).
1112add_requirements([H|T], Versions, Options) -->
1113 { member(Pack-PackVersions, Versions),
1114 member(Version-Infos, PackVersions),
1115 member(Info, Infos),
1116 ( Provides = @(Pack,Version)
1117 ; member(Provides, Info.get(provides))
1118 ),
1119 satisfies_req(Provides, H),
1120 all_downloads(PackVersions, Downloads)
1121 },
1122 add_to_plan(Info.put(_{version: Version, all_downloads:Downloads}),
1123 Versions, Options),
1124 add_requirements(T, Versions, Options).
1125
1131
1132add_to_plan(Info, _Versions, Options) -->
1133 { option(plan(Plan), Options),
1134 member_nonvar(Planned, Plan),
1135 Planned.pack == Info.pack,
1136 !,
1137 same_version(Planned, Info) 1138 }.
1139add_to_plan(Info, _Versions, _Options) -->
1140 { member(Conflict, Info.get(conflicts)),
1141 is_prolog_token(Conflict),
1142 prolog_satisfies(Conflict),
1143 !,
1144 fail 1145 }.
1146add_to_plan(Info, _Versions, Options) -->
1147 { option(plan(Plan), Options),
1148 member_nonvar(Planned, Plan),
1149 info_conflicts(Info, Planned), 1150 !,
1151 fail
1152 }.
1153add_to_plan(Info, Versions, Options) -->
1154 { select_option(dependency_for(Dep0), Options, Options1),
1155 Options2 = [dependency_for([Info.pack|Dep0])|Options1],
1156 ( Dep0 = [DepFor|_]
1157 -> add_dependency_for(DepFor, Info, Info1)
1158 ; Info1 = Info
1159 )
1160 },
1161 [Info1],
1162 add_requirements(Info.get(requires,[]), Versions, Options2).
1163
1164add_dependency_for(Pack, Info, Info) :-
1165 Old = Info.get(dependency_for),
1166 !,
1167 b_set_dict(dependency_for, Info, [Pack|Old]).
1168add_dependency_for(Pack, Info0, Info) :-
1169 Info = Info0.put(dependency_for, [Pack]).
1170
1171same_version(Info, Info) :-
1172 !.
1173same_version(Planned, Info) :-
1174 Hash = Planned.get(hash),
1175 Hash \== (-),
1176 !,
1177 Hash == Info.get(hash).
1178same_version(Planned, Info) :-
1179 Planned.get(version) == Info.get(version).
1180
1184
1185info_conflicts(Info, Planned) :-
1186 info_conflicts_(Info, Planned),
1187 !.
1188info_conflicts(Info, Planned) :-
1189 info_conflicts_(Planned, Info),
1190 !.
1191
1192info_conflicts_(Info, Planned) :-
1193 member(Conflict, Info.get(conflicts)),
1194 \+ is_prolog_token(Conflict),
1195 info_provides(Planned, Provides),
1196 satisfies_req(Provides, Conflict),
1197 !.
1198
1199info_provides(Info, Provides) :-
1200 ( Provides = Info.pack@Info.version
1201 ; member(Provides, Info.get(provides))
1202 ).
1203
1208
1209pack_satisfies(_Pack, _Version, Info0, Info, Options) :-
1210 option(commit('HEAD'), Options),
1211 !,
1212 Info0.get(git) == true,
1213 Info = Info0.put(commit, 'HEAD').
1214pack_satisfies(_Pack, _Version, Info, Info, Options) :-
1215 option(commit(Commit), Options),
1216 !,
1217 Commit == Info.get(hash).
1218pack_satisfies(Pack, Version, Info, Info, Options) :-
1219 option(version(ReqVersion), Options),
1220 !,
1221 satisfies_version(Pack, Version, ReqVersion).
1222pack_satisfies(_Pack, _Version, Info, Info, _Options).
1223
1225
1226satisfies_version(Pack, Version, ReqVersion) :-
1227 catch(require_version(pack(Pack), Version, ReqVersion),
1228 error(version_error(pack(Pack), Version, ReqVersion),_),
1229 fail).
1230
1234
1235satisfies_req(Token, Token) => true.
1236satisfies_req(@(Token,_), Token) => true.
1237satisfies_req(@(Token,PrvVersion), Req), cmp(Req, Token, Cmp, ReqVersion) =>
1238 cmp_versions(Cmp, PrvVersion, ReqVersion).
1239satisfies_req(_,_) => fail.
1240
1241cmp(Token < Version, Token, <, Version).
1242cmp(Token =< Version, Token, =<, Version).
1243cmp(Token = Version, Token, =, Version).
1244cmp(Token == Version, Token, ==, Version).
1245cmp(Token >= Version, Token, >=, Version).
1246cmp(Token > Version, Token, >, Version).
1247
1258
1259:- det(pack_options_to_versions/2). 1260pack_options_to_versions(Pack-PackOptions, Pack-Versions) :-
1261 option(versions(Available), PackOptions), !,
1262 maplist(version_url_info(Pack, PackOptions), Available, Versions).
1263pack_options_to_versions(Pack-PackOptions, Pack-[Version-[Info]]) :-
1264 option(url(URL), PackOptions),
1265 findall(Prop, option_info_prop(PackOptions, Prop), Pairs),
1266 dict_create(Info, #,
1267 [ pack-Pack,
1268 url-URL
1269 | Pairs
1270 ]),
1271 Version = Info.get(version, '0.0.0').
1272
1273version_url_info(Pack, PackOptions, Version-URL, Version-[Info]) :-
1274 findall(Prop,
1275 ( option_info_prop(PackOptions, Prop),
1276 Prop \= version-_
1277 ),
1278 Pairs),
1279 dict_create(Info, #,
1280 [ pack-Pack,
1281 url-URL,
1282 version-Version
1283 | Pairs
1284 ]).
1285
1286option_info_prop(PackOptions, Prop-Value) :-
1287 option_info(Prop),
1288 Opt =.. [Prop,Value],
1289 option(Opt, PackOptions).
1290
1291option_info(git).
1292option_info(hash).
1293option_info(version).
1294option_info(branch).
1295option_info(link).
1296
1301
1302compatible_version(Pack, Version, PackOptions) :-
1303 option(version(ReqVersion), PackOptions),
1304 !,
1305 satisfies_version(Pack, Version, ReqVersion).
1306compatible_version(_, _, _).
1307
1312
1313pack_options_compatible_with_info(Info, PackOptions) :-
1314 findall(Prop, option_info_prop(PackOptions, Prop), Pairs),
1315 dict_create(Dict, _, Pairs),
1316 Dict >:< Info.
1317
1325
1326download_plan(_Targets, Plan, Plan, _Options) :-
1327 exclude(installed, Plan, []),
1328 !.
1329download_plan(Targets, Plan0, Plan, Options) :-
1330 confirm(download_plan(Plan0), yes, Options),
1331 maplist(download_from_info(Options), Plan0, Plan1),
1332 plan_unsatisfied_dependencies(Plan1, Deps),
1333 ( Deps == []
1334 -> Plan = Plan1
1335 ; print_message(informational, pack(new_dependencies(Deps))),
1336 prolog_description(Properties),
1337 query_pack_server(versions(Deps, Properties), Result, []),
1338 ( Result = true(Versions)
1339 -> pack_resolve(Targets, Plan1, Versions, Plan2, Options),
1340 !,
1341 download_plan(Targets, Plan2, Plan, Options)
1342 ; print_message(error, pack(query_failed(Result))),
1343 fail
1344 )
1345 ).
1346
1351
1352plan_unsatisfied_dependencies(Plan, Deps) :-
1353 phrase(plan_unsatisfied_dependencies(Plan, Plan), Deps).
1354
1355plan_unsatisfied_dependencies([], _) -->
1356 [].
1357plan_unsatisfied_dependencies([Info|Infos], Plan) -->
1358 { Deps = Info.get(requires) },
1359 plan_unsatisfied_requirements(Deps, Plan),
1360 plan_unsatisfied_dependencies(Infos, Plan).
1361
1362plan_unsatisfied_requirements([], _) -->
1363 [].
1364plan_unsatisfied_requirements([H|T], Plan) -->
1365 { is_prolog_token(H), 1366 prolog_satisfies(H)
1367 },
1368 !,
1369 plan_unsatisfied_requirements(T, Plan).
1370plan_unsatisfied_requirements([H|T], Plan) -->
1371 { member(Info, Plan),
1372 ( ( Version = Info.get(version)
1373 -> Provides = @(Info.get(pack), Version)
1374 ; Provides = Info.get(pack)
1375 )
1376 ; member(Provides, Info.get(provides))
1377 ),
1378 satisfies_req(Provides, H)
1379 }, !,
1380 plan_unsatisfied_requirements(T, Plan).
1381plan_unsatisfied_requirements([H|T], Plan) -->
1382 [H],
1383 plan_unsatisfied_requirements(T, Plan).
1384
1385
1391
1392build_plan(Plan, Ordered, Options) :-
1393 partition(needs_rebuild_from_info(Options), Plan, ToBuild, NoBuild),
1394 maplist(attach_from_info(Options), NoBuild),
1395 ( ToBuild == []
1396 -> Ordered = []
1397 ; order_builds(ToBuild, Ordered),
1398 confirm(build_plan(Ordered), yes, Options),
1399 maplist(exec_plan_rebuild_step(Options), Ordered)
1400 ).
1401
1402needs_rebuild_from_info(Options, Info) :-
1403 needs_rebuild(Info.installed, Options).
1404
1408
1409needs_rebuild(PackDir, Options) :-
1410 ( is_foreign_pack(PackDir, _),
1411 \+ is_built(PackDir, Options)
1412 -> true
1413 ; is_autoload_pack(PackDir, Options),
1414 post_install_autoload(PackDir, Options),
1415 fail
1416 ).
1417
1424
1425is_built(PackDir, _Options) :-
1426 current_prolog_flag(arch, Arch),
1427 prolog_version_dotted(Version), 1428 pack_status_dir(PackDir, built(Arch, Version, _)).
1429
1434
1435order_builds(ToBuild, Ordered) :-
1436 findall(Pack-Dep, dep_edge(ToBuild, Pack, Dep), Edges),
1437 maplist(get_dict(pack), ToBuild, Packs),
1438 vertices_edges_to_ugraph(Packs, Edges, Graph),
1439 ugraph_layers(Graph, Layers),
1440 append(Layers, PackNames),
1441 maplist(pack_info_from_name(ToBuild), PackNames, Ordered).
1442
1443dep_edge(Infos, Pack, Dep) :-
1444 member(Info, Infos),
1445 Pack = Info.pack,
1446 member(Dep, Info.get(dependency_for)),
1447 ( member(DepInfo, Infos),
1448 DepInfo.pack == Dep
1449 -> true
1450 ).
1451
1452:- det(pack_info_from_name/3). 1453pack_info_from_name(Infos, Pack, Info) :-
1454 member(Info, Infos),
1455 Info.pack == Pack,
1456 !.
1457
1461
1462exec_plan_rebuild_step(Options, Info) :-
1463 print_message(informational, pack(build(Info.pack, Info.installed))),
1464 pack_post_install(Info.pack, Info.installed, Options),
1465 attach_from_info(Options, Info).
1466
1470
1471attach_from_info(_Options, Info) :-
1472 Info.get(keep) == true,
1473 !.
1474attach_from_info(Options, Info) :-
1475 ( option(pack_directory(_Parent), Options)
1476 -> pack_attach(Info.installed, [duplicate(replace)])
1477 ; pack_attach(Info.installed, [])
1478 ).
1479
1487
1488download_from_info(Options, Info0, Info), option(dryrun(true), Options) =>
1489 print_term(Info0, [nl(true)]),
1490 Info = Info0.
1491download_from_info(_Options, Info0, Info), installed(Info0) =>
1492 Info = Info0.
1493download_from_info(_Options, Info0, Info),
1494 _{upgrade:OldInfo, git:true} :< Info0,
1495 is_git_directory(OldInfo.installed) =>
1496 PackDir = OldInfo.installed,
1497 git_checkout_version(PackDir, [commit(Info0.hash)]),
1498 reload_info(PackDir, Info0, Info).
1499download_from_info(Options, Info0, Info),
1500 _{upgrade:OldInfo} :< Info0 =>
1501 PackDir = OldInfo.installed,
1502 detach_pack(OldInfo.pack, PackDir),
1503 delete_directory_and_contents(PackDir),
1504 del_dict(upgrade, Info0, _, Info1),
1505 download_from_info(Options, Info1, Info).
1506download_from_info(Options, Info0, Info),
1507 _{url:URL, git:true} :< Info0, \+ have_git =>
1508 git_archive_url(URL, Archive, Options),
1509 download_from_info([git_url(URL)|Options],
1510 Info0.put(_{ url:Archive,
1511 git:false,
1512 git_url:URL
1513 }),
1514 Info1),
1515 1516 ( Info1.get(version) == Info0.get(version),
1517 Hash = Info0.get(hash)
1518 -> Info = Info1.put(hash, Hash)
1519 ; Info = Info1
1520 ).
1521download_from_info(Options, Info0, Info),
1522 _{url:URL} :< Info0 =>
1523 select_option(pack_directory(Dir), Options, Options1),
1524 select_option(version(_), Options1, Options2, _),
1525 download_info_extra(Info0, InstallOptions, Options2),
1526 pack_download_from_url(URL, Dir, Info0.pack,
1527 [ interactive(false),
1528 pack_dir(PackDir)
1529 | InstallOptions
1530 ]),
1531 reload_info(PackDir, Info0, Info).
1532
(Info, [git(true),commit(Hash)|Options], Options) :-
1534 Info.get(git) == true,
1535 !,
1536 Hash = Info.get(commit, 'HEAD').
1537download_info_extra(_, Options, Options).
1538
1539installed(Info) :-
1540 _ = Info.get(installed).
1541
1542detach_pack(Pack, PackDir) :-
1543 ( current_pack(Pack, PackDir)
1544 -> '$pack_detach'(Pack, PackDir)
1545 ; true
1546 ).
1547
1554
1555reload_info(_PackDir, Info, Info) :-
1556 _ = Info.get(installed), 1557 !.
1558reload_info(PackDir, Info0, Info) :-
1559 local_pack_info(PackDir, Info1),
1560 Info = Info0.put(installed, PackDir)
1561 .put(downloaded, Info0.url)
1562 .put(Info1).
1563
1568
1569work_done(_, _, _, _, Options),
1570 option(silent(true), Options) =>
1571 true.
1572work_done(Targets, Plan, Plan, [], _Options) =>
1573 convlist(can_upgrade_target(Plan), Targets, CanUpgrade),
1574 ( CanUpgrade == []
1575 -> pairs_keys(Targets, Packs),
1576 print_message(informational, pack(up_to_date(Packs)))
1577 ; print_message(informational, pack(installed_can_upgrade(CanUpgrade)))
1578 ).
1579work_done(_, _, _, _, _) =>
1580 true.
1581
1582can_upgrade_target(Plan, Pack-_, Info) =>
1583 member(Info, Plan),
1584 Info.pack == Pack,
1585 !,
1586 _ = Info.get(latest_version).
1587
1592
1593local_packs(Dir, Packs) :-
1594 findall(Pack, pack_in_subdir(Dir, Pack), Packs).
1595
1596pack_in_subdir(Dir, Info) :-
1597 directory_member(Dir, PackDir,
1598 [ file_type(directory),
1599 hidden(false)
1600 ]),
1601 local_pack_info(PackDir, Info).
1602
1603local_pack_info(PackDir,
1604 #{ pack: Pack,
1605 version: Version,
1606 title: Title,
1607 hash: Hash,
1608 url: URL,
1609 git: IsGit,
1610 requires: Requires,
1611 provides: Provides,
1612 conflicts: Conflicts,
1613 installed: PackDir
1614 }) :-
1615 directory_file_path(PackDir, 'pack.pl', MetaFile),
1616 exists_file(MetaFile),
1617 file_base_name(PackDir, DirName),
1618 findall(Term, pack_dir_info(PackDir, _, Term), Info),
1619 option(pack(Pack), Info, DirName),
1620 option(title(Title), Info, '<no title>'),
1621 option(version(Version), Info, '<no version>'),
1622 option(download(URL), Info, '<no download url>'),
1623 findall(Req, member(requires(Req), Info), Requires),
1624 findall(Prv, member(provides(Prv), Info), Provides),
1625 findall(Cfl, member(conflicts(Cfl), Info), Conflicts),
1626 ( have_git,
1627 is_git_directory(PackDir)
1628 -> git_hash(Hash, [directory(PackDir)]),
1629 IsGit = true
1630 ; Hash = '-',
1631 IsGit = false
1632 ).
1633
1634
1635 1638
1647
1648prolog_description([prolog(swi(Version))]) :-
1649 prolog_version(Version).
1650
1651prolog_version(Version) :-
1652 current_prolog_flag(version_git, Version),
1653 !.
1654prolog_version(Version) :-
1655 prolog_version_dotted(Version).
1656
1657prolog_version_dotted(Version) :-
1658 current_prolog_flag(version_data, swi(Major, Minor, Patch, _)),
1659 VNumbers = [Major, Minor, Patch],
1660 atomic_list_concat(VNumbers, '.', Version).
1661
1666
1667is_prolog_token(Token), cmp(Token, prolog, _Cmp, _Version) => true.
1668is_prolog_token(prolog:_Feature) => true.
1669is_prolog_token(_) => fail.
1670
1683
1684prolog_satisfies(Token), cmp(Token, prolog, Cmp, ReqVersion) =>
1685 prolog_version(CurrentVersion),
1686 cmp_versions(Cmp, CurrentVersion, ReqVersion).
1687prolog_satisfies(prolog:library(Lib)), atom(Lib) =>
1688 exists_source(library(Lib)).
1689prolog_satisfies(prolog:Feature), atom(Feature) =>
1690 current_prolog_flag(Feature, true).
1691prolog_satisfies(prolog:Feature), flag_value_feature(Feature, Flag, Value) =>
1692 current_prolog_flag(Flag, Value).
1693
1694flag_value_feature(Feature, Flag, Value) :-
1695 compound(Feature),
1696 compound_name_arguments(Feature, Flag, [Value]).
1697
1698
1699 1702
1714
1715:- if(exists_source(library(archive))). 1716ensure_loaded_archive :-
1717 current_predicate(archive_open/3),
1718 !.
1719ensure_loaded_archive :-
1720 use_module(library(archive)).
1721
1722pack_archive_info(Archive, Pack, [archive_size(Bytes)|Info], Strip) :-
1723 ensure_loaded_archive,
1724 size_file(Archive, Bytes),
1725 setup_call_cleanup(
1726 archive_open(Archive, Handle, []),
1727 ( repeat,
1728 ( archive_next_header(Handle, InfoFile)
1729 -> true
1730 ; !, fail
1731 )
1732 ),
1733 archive_close(Handle)),
1734 file_base_name(InfoFile, 'pack.pl'),
1735 atom_concat(Prefix, 'pack.pl', InfoFile),
1736 strip_option(Prefix, Pack, Strip),
1737 setup_call_cleanup(
1738 archive_open_entry(Handle, Stream),
1739 read_stream_to_terms(Stream, Info),
1740 close(Stream)),
1741 !,
1742 must_be(ground, Info),
1743 maplist(valid_term(pack_info_term), Info).
1744:- else. 1745pack_archive_info(_, _, _, _) :-
1746 existence_error(library, archive).
1747:- endif. 1748pack_archive_info(_, _, _, _) :-
1749 existence_error(pack_file, 'pack.pl').
1750
1751strip_option('', _, []) :- !.
1752strip_option('./', _, []) :- !.
1753strip_option(Prefix, Pack, [remove_prefix(Prefix)]) :-
1754 atom_concat(PrefixDir, /, Prefix),
1755 file_base_name(PrefixDir, Base),
1756 ( Base == Pack
1757 -> true
1758 ; pack_version_file(Pack, _, Base)
1759 -> true
1760 ; \+ sub_atom(PrefixDir, _, _, _, /)
1761 ).
1762
1763read_stream_to_terms(Stream, Terms) :-
1764 read(Stream, Term0),
1765 read_stream_to_terms(Term0, Stream, Terms).
1766
1767read_stream_to_terms(end_of_file, _, []) :- !.
1768read_stream_to_terms(Term0, Stream, [Term0|Terms]) :-
1769 read(Stream, Term1),
1770 read_stream_to_terms(Term1, Stream, Terms).
1771
1772
1777
1778pack_git_info(GitDir, Hash, [git(true), installed_size(Bytes)|Info]) :-
1779 exists_directory(GitDir),
1780 !,
1781 git_ls_tree(Entries, [directory(GitDir)]),
1782 git_hash(Hash, [directory(GitDir)]),
1783 maplist(arg(4), Entries, Sizes),
1784 sum_list(Sizes, Bytes),
1785 dir_metadata(GitDir, Info).
1786
1787dir_metadata(GitDir, Info) :-
1788 directory_file_path(GitDir, 'pack.pl', InfoFile),
1789 read_file_to_terms(InfoFile, Info, [encoding(utf8)]),
1790 must_be(ground, Info),
1791 maplist(valid_term(pack_info_term), Info).
1792
1796
1797download_file_sanity_check(Archive, Pack, Info) :-
1798 info_field(name(PackName), Info),
1799 info_field(version(PackVersion), Info),
1800 pack_version_file(PackFile, FileVersion, Archive),
1801 must_match([Pack, PackName, PackFile], name),
1802 must_match([PackVersion, FileVersion], version).
1803
1804info_field(Field, Info) :-
1805 memberchk(Field, Info),
1806 ground(Field),
1807 !.
1808info_field(Field, _Info) :-
1809 functor(Field, FieldName, _),
1810 print_message(error, pack(missing(FieldName))),
1811 fail.
1812
1813must_match(Values, _Field) :-
1814 sort(Values, [_]),
1815 !.
1816must_match(Values, Field) :-
1817 print_message(error, pack(conflict(Field, Values))),
1818 fail.
1819
1820
1821 1824
1836
1837prepare_pack_dir(Dir, Options) :-
1838 exists_directory(Dir),
1839 !,
1840 ( empty_directory(Dir)
1841 -> true
1842 ; remove_existing_pack(Dir, Options)
1843 -> make_directory(Dir)
1844 ).
1845prepare_pack_dir(Dir, _) :-
1846 ( read_link(Dir, _, _)
1847 ; access_file(Dir, exist)
1848 ),
1849 !,
1850 delete_file(Dir),
1851 make_directory(Dir).
1852prepare_pack_dir(Dir, _) :-
1853 make_directory(Dir).
1854
1858
1859empty_directory(Dir) :-
1860 \+ ( directory_files(Dir, Entries),
1861 member(Entry, Entries),
1862 \+ special(Entry)
1863 ).
1864
1865special(.).
1866special(..).
1867
1874
1875remove_existing_pack(PackDir, Options) :-
1876 exists_directory(PackDir),
1877 !,
1878 ( ( option(upgrade(true), Options)
1879 ; confirm(remove_existing_pack(PackDir), yes, Options)
1880 )
1881 -> delete_directory_and_contents(PackDir)
1882 ; print_message(error, pack(directory_exists(PackDir))),
1883 fail
1884 ).
1885remove_existing_pack(_, _).
1886
1900
1901pack_download_from_url(URL, PackTopDir, Pack, Options) :-
1902 option(git(true), Options),
1903 !,
1904 directory_file_path(PackTopDir, Pack, PackDir),
1905 prepare_pack_dir(PackDir, Options),
1906 ( option(branch(Branch), Options)
1907 -> Extra = ['--branch', Branch]
1908 ; Extra = []
1909 ),
1910 run_process(path(git), [clone, URL, PackDir|Extra], []),
1911 git_checkout_version(PackDir, [update(false)|Options]),
1912 option(pack_dir(PackDir), Options, _).
1913pack_download_from_url(URL, PackTopDir, Pack, Options) :-
1914 download_url(URL),
1915 !,
1916 directory_file_path(PackTopDir, Pack, PackDir),
1917 prepare_pack_dir(PackDir, Options),
1918 pack_download_dir(PackTopDir, DownLoadDir),
1919 download_file(URL, Pack, DownloadBase, Options),
1920 directory_file_path(DownLoadDir, DownloadBase, DownloadFile),
1921 ( option(insecure(true), Options, false)
1922 -> TLSOptions = [cert_verify_hook(ssl_verify)]
1923 ; TLSOptions = []
1924 ),
1925 print_message(informational, pack(download(begin, Pack, URL, DownloadFile))),
1926 setup_call_cleanup(
1927 http_open(URL, In, TLSOptions),
1928 setup_call_cleanup(
1929 open(DownloadFile, write, Out, [type(binary)]),
1930 copy_stream_data(In, Out),
1931 close(Out)),
1932 close(In)),
1933 print_message(informational, pack(download(end, Pack, URL, DownloadFile))),
1934 pack_archive_info(DownloadFile, Pack, Info, _),
1935 ( option(git_url(GitURL), Options)
1936 -> Origin = GitURL 1937 ; download_file_sanity_check(DownloadFile, Pack, Info),
1938 Origin = URL
1939 ),
1940 pack_unpack_from_local(DownloadFile, PackTopDir, Pack, PackDir, Options),
1941 pack_assert(PackDir, archive(DownloadFile, Origin)),
1942 option(pack_dir(PackDir), Options, _).
1943pack_download_from_url(URL, PackTopDir, Pack, Options) :-
1944 local_uri_file_name(URL, File),
1945 !,
1946 pack_unpack_from_local(File, PackTopDir, Pack, PackDir, Options),
1947 pack_assert(PackDir, archive(File, URL)),
1948 option(pack_dir(PackDir), Options, _).
1949pack_download_from_url(URL, _PackTopDir, _Pack, _Options) :-
1950 domain_error(url, URL).
1951
1973
1974git_checkout_version(PackDir, Options) :-
1975 option(commit('HEAD'), Options),
1976 option(branch(Branch), Options),
1977 !,
1978 git_ensure_on_branch(PackDir, Branch),
1979 run_process(path(git), ['-C', PackDir, pull], []).
1980git_checkout_version(PackDir, Options) :-
1981 option(commit('HEAD'), Options),
1982 git_current_branch(_, [directory(PackDir)]),
1983 !,
1984 run_process(path(git), ['-C', PackDir, pull], []).
1985git_checkout_version(PackDir, Options) :-
1986 option(commit('HEAD'), Options),
1987 !,
1988 git_default_branch(Branch, [directory(PackDir)]),
1989 git_ensure_on_branch(PackDir, Branch),
1990 run_process(path(git), ['-C', PackDir, pull], []).
1991git_checkout_version(PackDir, Options) :-
1992 option(commit(Hash), Options),
1993 run_process(path(git), ['-C', PackDir, fetch], []),
1994 git_branches(Branches, [contains(Hash), directory(PackDir)]),
1995 git_process_output(['-C', PackDir, 'rev-parse' | Branches],
1996 read_lines_to_atoms(Commits),
1997 []),
1998 nth1(I, Commits, Hash),
1999 nth1(I, Branches, Branch),
2000 !,
2001 git_ensure_on_branch(PackDir, Branch).
2002git_checkout_version(PackDir, Options) :-
2003 option(commit(Hash), Options),
2004 !,
2005 run_process(path(git), ['-C', PackDir, checkout, '--quiet', Hash], []).
2006git_checkout_version(PackDir, Options) :-
2007 option(version(Version), Options),
2008 !,
2009 git_tags(Tags, [directory(PackDir)]),
2010 ( memberchk(Version, Tags)
2011 -> Tag = Version
2012 ; member(Tag, Tags),
2013 sub_atom(Tag, B, _, 0, Version),
2014 sub_atom(Tag, 0, B, _, Prefix),
2015 version_prefix(Prefix)
2016 -> true
2017 ; existence_error(version_tag, Version)
2018 ),
2019 run_process(path(git), ['-C', PackDir, checkout, Tag], []).
2020git_checkout_version(_PackDir, Options) :-
2021 option(fresh(true), Options),
2022 !.
2023git_checkout_version(PackDir, _Options) :-
2024 git_current_branch(_, [directory(PackDir)]),
2025 !,
2026 run_process(path(git), ['-C', PackDir, pull], []).
2027git_checkout_version(PackDir, _Options) :-
2028 git_default_branch(Branch, [directory(PackDir)]),
2029 git_ensure_on_branch(PackDir, Branch),
2030 run_process(path(git), ['-C', PackDir, pull], []).
2031
2035
2036git_ensure_on_branch(PackDir, Branch) :-
2037 git_current_branch(Branch, [directory(PackDir)]),
2038 !.
2039git_ensure_on_branch(PackDir, Branch) :-
2040 run_process(path(git), ['-C', PackDir, checkout, Branch], []).
2041
2042read_lines_to_atoms(Atoms, In) :-
2043 read_line_to_string(In, Line),
2044 ( Line == end_of_file
2045 -> Atoms = []
2046 ; atom_string(Atom, Line),
2047 Atoms = [Atom|T],
2048 read_lines_to_atoms(T, In)
2049 ).
2050
2051version_prefix(Prefix) :-
2052 atom_codes(Prefix, Codes),
2053 phrase(version_prefix, Codes).
2054
2055version_prefix -->
2056 [C],
2057 { code_type(C, alpha) },
2058 !,
2059 version_prefix.
2060version_prefix -->
2061 "-".
2062version_prefix -->
2063 "_".
2064version_prefix -->
2065 "".
2066
2071
2072download_file(URL, Pack, File, Options) :-
2073 option(version(Version), Options),
2074 !,
2075 file_name_extension(_, Ext, URL),
2076 format(atom(File), '~w-~w.~w', [Pack, Version, Ext]).
2077download_file(URL, Pack, File, _) :-
2078 file_base_name(URL,Basename),
2079 no_int_file_name_extension(Tag,Ext,Basename),
2080 tag_version(Tag,Version),
2081 !,
2082 format(atom(File0), '~w-~w', [Pack, Version]),
2083 file_name_extension(File0, Ext, File).
2084download_file(URL, _, File, _) :-
2085 file_base_name(URL, File).
2086
2092
2093:- public pack_url_file/2. 2094pack_url_file(URL, FileID) :-
2095 github_release_url(URL, Pack, Version),
2096 !,
2097 download_file(URL, Pack, FileID, [version(Version)]).
2098pack_url_file(URL, FileID) :-
2099 file_base_name(URL, FileID).
2100
2105
2106:- public ssl_verify/5. 2107ssl_verify(_SSL,
2108 _ProblemCertificate, _AllCertificates, _FirstCertificate,
2109 _Error).
2110
2111pack_download_dir(PackTopDir, DownLoadDir) :-
2112 directory_file_path(PackTopDir, 'Downloads', DownLoadDir),
2113 ( exists_directory(DownLoadDir)
2114 -> true
2115 ; make_directory(DownLoadDir)
2116 ),
2117 ( access_file(DownLoadDir, write)
2118 -> true
2119 ; permission_error(write, directory, DownLoadDir)
2120 ).
2121
2127
2128download_url(URL) :-
2129 atom(URL),
2130 uri_components(URL, Components),
2131 uri_data(scheme, Components, Scheme),
2132 download_scheme(Scheme).
2133
2134download_scheme(http).
2135download_scheme(https).
2136
2144
2145pack_post_install(Pack, PackDir, Options) :-
2146 post_install_foreign(Pack, PackDir, Options),
2147 post_install_autoload(PackDir, Options),
2148 attach_packs(PackDir, [duplicate(warning)]).
2149
2155
2156pack_rebuild :-
2157 forall(current_pack(Pack),
2158 ( print_message(informational, pack(rebuild(Pack))),
2159 pack_rebuild(Pack)
2160 )).
2161
2162pack_rebuild(Pack) :-
2163 current_pack(Pack, PackDir),
2164 !,
2165 post_install_foreign(Pack, PackDir, [rebuild(true)]).
2166pack_rebuild(Pack) :-
2167 unattached_pack(Pack, PackDir),
2168 !,
2169 post_install_foreign(Pack, PackDir, [rebuild(true)]).
2170pack_rebuild(Pack) :-
2171 existence_error(pack, Pack).
2172
2173unattached_pack(Pack, BaseDir) :-
2174 directory_file_path(Pack, 'pack.pl', PackFile),
2175 absolute_file_name(pack(PackFile), PackPath,
2176 [ access(read),
2177 file_errors(fail)
2178 ]),
2179 file_directory_name(PackPath, BaseDir).
2180
2181
2182
2194
2195post_install_foreign(Pack, PackDir, Options) :-
2196 is_foreign_pack(PackDir, _),
2197 !,
2198 ( pack_info_term(PackDir, pack_version(Version))
2199 -> true
2200 ; Version = 1
2201 ),
2202 option(rebuild(Rebuild), Options, if_absent),
2203 current_prolog_flag(arch, Arch),
2204 prolog_version_dotted(PrologVersion),
2205 ( Rebuild == if_absent,
2206 foreign_present(PackDir, Arch)
2207 -> print_message(informational, pack(kept_foreign(Pack, Arch))),
2208 ( pack_status_dir(PackDir, built(Arch, _, _))
2209 -> true
2210 ; pack_assert(PackDir, built(Arch, PrologVersion, downloaded))
2211 )
2212 ; BuildSteps0 = [[dependencies], [configure], build, install, [test]],
2213 ( Rebuild == true
2214 -> BuildSteps1 = [distclean|BuildSteps0]
2215 ; BuildSteps1 = BuildSteps0
2216 ),
2217 ( option(test(false), Options)
2218 -> delete(BuildSteps1, [test], BuildSteps2)
2219 ; BuildSteps2 = BuildSteps1
2220 ),
2221 ( option(clean(true), Options)
2222 -> append(BuildSteps2, [[clean]], BuildSteps)
2223 ; BuildSteps = BuildSteps2
2224 ),
2225 build_steps(BuildSteps, PackDir, [pack_version(Version)|Options]),
2226 pack_assert(PackDir, built(Arch, PrologVersion, built))
2227 ).
2228post_install_foreign(_, _, _).
2229
2230
2238
2239foreign_present(PackDir, Arch) :-
2240 atomic_list_concat([PackDir, '/lib'], ForeignBaseDir),
2241 exists_directory(ForeignBaseDir),
2242 !,
2243 atomic_list_concat([PackDir, '/lib/', Arch], ForeignDir),
2244 exists_directory(ForeignDir),
2245 current_prolog_flag(shared_object_extension, Ext),
2246 atomic_list_concat([ForeignDir, '/*.', Ext], Pattern),
2247 expand_file_name(Pattern, Files),
2248 Files \== [].
2249
2254
2255is_foreign_pack(PackDir, Type) :-
2256 foreign_file(File, Type),
2257 directory_file_path(PackDir, File, Path),
2258 exists_file(Path).
2259
2260foreign_file('CMakeLists.txt', cmake).
2261foreign_file('configure', configure).
2262foreign_file('configure.in', autoconf).
2263foreign_file('configure.ac', autoconf).
2264foreign_file('Makefile.am', automake).
2265foreign_file('Makefile', make).
2266foreign_file('makefile', make).
2267foreign_file('conanfile.txt', conan).
2268foreign_file('conanfile.py', conan).
2269
2270
2271 2274
2278
2279post_install_autoload(PackDir, Options) :-
2280 is_autoload_pack(PackDir, Options),
2281 !,
2282 directory_file_path(PackDir, prolog, PrologLibDir),
2283 make_library_index(PrologLibDir).
2284post_install_autoload(_, _).
2285
2286is_autoload_pack(PackDir, Options) :-
2287 option(autoload(true), Options, true),
2288 pack_info_term(PackDir, autoload(true)).
2289
2290
2291 2294
2298
2299pack_upgrade(Pack) :-
2300 pack_install(Pack, [upgrade(true)]).
2301
2302
2303 2306
2317
2318pack_remove(Pack) :-
2319 pack_remove(Pack, []).
2320
2321pack_remove(Pack, Options) :-
2322 option(dependencies(false), Options),
2323 !,
2324 pack_remove_forced(Pack).
2325pack_remove(Pack, Options) :-
2326 ( dependents(Pack, Deps)
2327 -> ( option(dependencies(true), Options)
2328 -> true
2329 ; confirm_remove(Pack, Deps, Delete, Options)
2330 ),
2331 forall(member(P, Delete), pack_remove_forced(P))
2332 ; pack_remove_forced(Pack)
2333 ).
2334
2335pack_remove_forced(Pack) :-
2336 catch('$pack_detach'(Pack, BaseDir),
2337 error(existence_error(pack, Pack), _),
2338 fail),
2339 !,
2340 print_message(informational, pack(remove(BaseDir))),
2341 delete_directory_and_contents(BaseDir).
2342pack_remove_forced(Pack) :-
2343 unattached_pack(Pack, BaseDir),
2344 !,
2345 delete_directory_and_contents(BaseDir).
2346pack_remove_forced(Pack) :-
2347 print_message(informational, error(existence_error(pack, Pack),_)).
2348
2349confirm_remove(Pack, Deps, Delete, Options) :-
2350 print_message(warning, pack(depends(Pack, Deps))),
2351 menu(pack(resolve_remove),
2352 [ [Pack] = remove_only(Pack),
2353 [Pack|Deps] = remove_deps(Pack, Deps),
2354 [] = cancel
2355 ], [], Delete, Options),
2356 Delete \== [].
2357
2358
2359 2362
2413
2414pack_publish(Dir, Options) :-
2415 \+ download_url(Dir),
2416 is_git_directory(Dir), !,
2417 pack_git_info(Dir, _Hash, Metadata),
2418 prepare_repository(Dir, Metadata, Options),
2419 ( memberchk(download(URL), Metadata),
2420 git_url(URL, _)
2421 -> true
2422 ; option(remote(Remote), Options, origin),
2423 git_remote_url(Remote, RemoteURL, [directory(Dir)]),
2424 git_to_https_url(RemoteURL, URL)
2425 ),
2426 memberchk(version(Version), Metadata),
2427 pack_publish_(URL,
2428 [ version(Version)
2429 | Options
2430 ]).
2431pack_publish(Spec, Options) :-
2432 pack_publish_(Spec, Options).
2433
2434pack_publish_(Spec, Options) :-
2435 pack_default_options(Spec, Pack, Options, DefOptions),
2436 option(url(URL), DefOptions),
2437 valid_publish_url(URL, Options),
2438 prepare_build_location(Pack, Dir, Clean, Options),
2439 ( option(register(false), Options)
2440 -> InstallOptions = DefOptions
2441 ; InstallOptions = [publish(Pack)|DefOptions]
2442 ),
2443 call_cleanup(pack_install(Pack,
2444 [ pack(Pack)
2445 | InstallOptions
2446 ]),
2447 cleanup_publish(Clean, Dir)).
2448
2449cleanup_publish(true, Dir) :-
2450 !,
2451 delete_directory_and_contents(Dir).
2452cleanup_publish(_, _).
2453
2454valid_publish_url(URL, Options) :-
2455 option(register(Register), Options, true),
2456 ( Register == false
2457 -> true
2458 ; download_url(URL)
2459 -> true
2460 ; permission_error(publish, pack, URL)
2461 ).
2462
2463prepare_build_location(Pack, Dir, Clean, Options) :-
2464 ( option(pack_directory(Dir), Options)
2465 -> ensure_directory(Dir),
2466 ( option(clean(true), Options, true)
2467 -> delete_directory_contents(Dir)
2468 ; true
2469 )
2470 ; tmp_file(pack, Dir),
2471 make_directory(Dir),
2472 Clean = true
2473 ),
2474 ( option(isolated(false), Options)
2475 -> detach_pack(Pack, _),
2476 attach_packs(Dir, [search(first)])
2477 ; attach_packs(Dir, [replace(true)])
2478 ).
2479
2480
2481
2488
2489prepare_repository(_Dir, _Metadata, Options) :-
2490 option(register(false), Options),
2491 !.
2492prepare_repository(Dir, Metadata, Options) :-
2493 git_dir_must_be_clean(Dir),
2494 git_must_be_on_default_branch(Dir, Options),
2495 tag_git_dir(Dir, Metadata, Action, Options),
2496 confirm(git_push, yes, Options),
2497 run_process(path(git), ['-C', file(Dir), push ], []),
2498 ( Action = push_tag(Tag)
2499 -> run_process(path(git), ['-C', file(Dir), push, origin, Tag ], [])
2500 ; true
2501 ).
2502
2503git_dir_must_be_clean(Dir) :-
2504 git_describe(Description, [directory(Dir)]),
2505 ( sub_atom(Description, _, _, 0, '-DIRTY')
2506 -> print_message(error, pack(git_not_clean(Dir))),
2507 fail
2508 ; true
2509 ).
2510
2511git_must_be_on_default_branch(Dir, Options) :-
2512 ( option(branch(Default), Options)
2513 -> true
2514 ; git_default_branch(Default, [directory(Dir)])
2515 ),
2516 git_current_branch(Current, [directory(Dir)]),
2517 ( Default == Current
2518 -> true
2519 ; print_message(error,
2520 pack(git_branch_not_default(Dir, Default, Current))),
2521 fail
2522 ).
2523
2524
2530
2531tag_git_dir(Dir, Metadata, Action, Options) :-
2532 memberchk(version(Version), Metadata),
2533 atom_concat('V', Version, Tag),
2534 git_tags(Tags, [directory(Dir)]),
2535 ( memberchk(Tag, Tags)
2536 -> git_tag_is_consistent(Dir, Tag, Action, Options)
2537 ; format(string(Message), 'Release ~w', [Version]),
2538 findall(Opt, git_tag_option(Opt, Options), Argv,
2539 [ '-m', Message, Tag ]),
2540 confirm(git_tag(Tag), yes, Options),
2541 run_process(path(git), ['-C', file(Dir), tag | Argv ], []),
2542 Action = push_tag(Tag)
2543 ).
2544
2545git_tag_option('-s', Options) :- option(sign(true), Options, true).
2546git_tag_option('-f', Options) :- option(force(true), Options, true).
2547
2548git_tag_is_consistent(Dir, Tag, Action, Options) :-
2549 format(atom(TagRef), 'refs/tags/~w', [Tag]),
2550 format(atom(CommitRef), 'refs/tags/~w^{}', [Tag]),
2551 option(remote(Remote), Options, origin),
2552 git_ls_remote(Dir, LocalTags, [tags(true)]),
2553 memberchk(CommitHash-CommitRef, LocalTags),
2554 ( git_hash(CommitHash, [directory(Dir)])
2555 -> true
2556 ; print_message(error, pack(git_release_tag_not_at_head(Tag))),
2557 fail
2558 ),
2559 memberchk(TagHash-TagRef, LocalTags),
2560 git_ls_remote(Remote, RemoteTags, [tags(true)]),
2561 ( memberchk(RemoteCommitHash-CommitRef, RemoteTags),
2562 memberchk(RemoteTagHash-TagRef, RemoteTags)
2563 -> ( RemoteCommitHash == CommitHash,
2564 RemoteTagHash == TagHash
2565 -> Action = none
2566 ; print_message(error, pack(git_tag_out_of_sync(Tag))),
2567 fail
2568 )
2569 ; Action = push_tag(Tag)
2570 ).
2571
2577
2578git_to_https_url(URL, URL) :-
2579 download_url(URL),
2580 !.
2581git_to_https_url(GitURL, URL) :-
2582 atom_concat('git@github.com:', Repo, GitURL),
2583 !,
2584 atom_concat('https://github.com/', Repo, URL).
2585git_to_https_url(GitURL, _) :-
2586 print_message(error, pack(git_no_https(GitURL))),
2587 fail.
2588
2589
2590 2593
2614
2615pack_property(Pack, Property) :-
2616 findall(Pack-Property, pack_property_(Pack, Property), List),
2617 member(Pack-Property, List). 2618
2619pack_property_(Pack, Property) :-
2620 pack_info(Pack, _, Property).
2621pack_property_(Pack, Property) :-
2622 \+ \+ info_file(Property, _),
2623 '$pack':pack(Pack, BaseDir),
2624 access_file(BaseDir, read),
2625 directory_files(BaseDir, Files),
2626 member(File, Files),
2627 info_file(Property, Pattern),
2628 downcase_atom(File, Pattern),
2629 directory_file_path(BaseDir, File, InfoFile),
2630 arg(1, Property, InfoFile).
2631
2632info_file(readme(_), 'readme.txt').
2633info_file(readme(_), 'readme').
2634info_file(todo(_), 'todo.txt').
2635info_file(todo(_), 'todo').
2636
2637
2638 2641
2648
2649pack_version_file(Pack, Version, GitHubRelease) :-
2650 atomic(GitHubRelease),
2651 github_release_url(GitHubRelease, Pack, Version),
2652 !.
2653pack_version_file(Pack, Version, Path) :-
2654 atomic(Path),
2655 file_base_name(Path, File),
2656 no_int_file_name_extension(Base, _Ext, File),
2657 atom_codes(Base, Codes),
2658 ( phrase(pack_version(Pack, Version), Codes),
2659 safe_pack_name(Pack)
2660 -> true
2661 ).
2662
2663no_int_file_name_extension(Base, Ext, File) :-
2664 file_name_extension(Base0, Ext0, File),
2665 \+ atom_number(Ext0, _),
2666 !,
2667 Base = Base0,
2668 Ext = Ext0.
2669no_int_file_name_extension(File, '', File).
2670
2675
2676safe_pack_name(Name) :-
2677 atom_length(Name, Len),
2678 Len >= 3, 2679 atom_codes(Name, Codes),
2680 maplist(safe_pack_char, Codes),
2681 !.
2682
2683safe_pack_char(C) :- between(0'a, 0'z, C), !.
2684safe_pack_char(C) :- between(0'A, 0'Z, C), !.
2685safe_pack_char(C) :- between(0'0, 0'9, C), !.
2686safe_pack_char(0'_).
2687
2691
2692pack_version(Pack, Version) -->
2693 string(Codes), "-",
2694 version(Parts),
2695 !,
2696 { atom_codes(Pack, Codes),
2697 atomic_list_concat(Parts, '.', Version)
2698 }.
2699
2700version([H|T]) -->
2701 version_part(H),
2702 ( "."
2703 -> version(T)
2704 ; {T=[]}
2705 ).
2706
2707version_part(*) --> "*", !.
2708version_part(Int) --> integer(Int).
2709
2710
2711 2714
2715have_git :-
2716 process_which(path(git), _).
2717
2718
2722
2723git_url(URL, Pack) :-
2724 uri_components(URL, Components),
2725 uri_data(scheme, Components, Scheme),
2726 nonvar(Scheme), 2727 uri_data(path, Components, Path),
2728 ( Scheme == git
2729 -> true
2730 ; git_download_scheme(Scheme),
2731 file_name_extension(_, git, Path)
2732 ; git_download_scheme(Scheme),
2733 catch(git_ls_remote(URL, _, [refs(['HEAD']), error(_)]), _, fail)
2734 -> true
2735 ),
2736 file_base_name(Path, PackExt),
2737 ( file_name_extension(Pack, git, PackExt)
2738 -> true
2739 ; Pack = PackExt
2740 ),
2741 ( safe_pack_name(Pack)
2742 -> true
2743 ; domain_error(pack_name, Pack)
2744 ).
2745
2746git_download_scheme(http).
2747git_download_scheme(https).
2748
2755
2756github_release_url(URL, Pack, Version) :-
2757 uri_components(URL, Components),
2758 uri_data(authority, Components, 'github.com'),
2759 uri_data(scheme, Components, Scheme),
2760 download_scheme(Scheme),
2761 uri_data(path, Components, Path),
2762 github_archive_path(Archive,Pack,File),
2763 atomic_list_concat(Archive, /, Path),
2764 file_name_extension(Tag, Ext, File),
2765 github_archive_extension(Ext),
2766 tag_version(Tag, Version),
2767 !.
2768
2769github_archive_path(['',_User,Pack,archive,File],Pack,File).
2770github_archive_path(['',_User,Pack,archive,refs,tags,File],Pack,File).
2771
2772github_archive_extension(tgz).
2773github_archive_extension(zip).
2774
2779
2780tag_version(Tag, Version) :-
2781 version_tag_prefix(Prefix),
2782 atom_concat(Prefix, Version, Tag),
2783 is_version(Version).
2784
2785version_tag_prefix(v).
2786version_tag_prefix('V').
2787version_tag_prefix('').
2788
2789
2795
2796git_archive_url(URL, Archive, Options) :-
2797 uri_components(URL, Components),
2798 uri_data(authority, Components, 'github.com'),
2799 uri_data(path, Components, Path),
2800 atomic_list_concat(['', User, RepoGit], /, Path),
2801 $,
2802 remove_git_ext(RepoGit, Repo),
2803 git_archive_version(Version, Options),
2804 atomic_list_concat(['', User, Repo, zip, Version], /, ArchivePath),
2805 uri_edit([ path(ArchivePath),
2806 host('codeload.github.com')
2807 ],
2808 URL, Archive).
2809git_archive_url(URL, _, _) :-
2810 print_message(error, pack(no_git(URL))),
2811 fail.
2812
2813remove_git_ext(RepoGit, Repo) :-
2814 file_name_extension(Repo, git, RepoGit),
2815 !.
2816remove_git_ext(Repo, Repo).
2817
2818git_archive_version(Version, Options) :-
2819 option(commit(Version), Options),
2820 !.
2821git_archive_version(Version, Options) :-
2822 option(branch(Version), Options),
2823 !.
2824git_archive_version(Version, Options) :-
2825 option(version(Version), Options),
2826 !.
2827git_archive_version('HEAD', _).
2828
2829 2832
2837
2838register_downloads(_, Options) :-
2839 option(register(false), Options),
2840 \+ option(do_publish(_), Options),
2841 !.
2842register_downloads(Infos, Options) :-
2843 convlist(download_data, Infos, Data),
2844 ( Data == []
2845 -> true
2846 ; query_pack_server(downloaded(Data), Reply, Options),
2847 ( option(do_publish(Pack), Options)
2848 -> ( member(Info, Infos),
2849 Info.pack == Pack
2850 -> true
2851 ),
2852 ( Reply = true(Actions),
2853 memberchk(Pack-Result, Actions)
2854 -> ( registered(Result)
2855 -> true
2856 ; print_message(error, pack(publish_failed(Info, Result))),
2857 fail
2858 )
2859 ; print_message(error, pack(publish_failed(Info, false)))
2860 )
2861 ; true
2862 )
2863 ).
2864
2865registered(git(_URL)).
2866registered(file(_URL)).
2867
2868publish_download(Infos, Options) :-
2869 select_option(publish(Pack), Options, Options1),
2870 !,
2871 register_downloads(Infos, [do_publish(Pack)|Options1]).
2872publish_download(_Infos, _Options).
2873
2874download_data(Info, Data),
2875 Info.get(git) == true => 2876 Data = download(URL, Hash, Metadata),
2877 URL = Info.get(downloaded),
2878 pack_git_info(Info.installed, Hash, Metadata).
2879download_data(Info, Data),
2880 _{git_url:URL,hash:Hash} :< Info, Hash \== (-) =>
2881 Data = download(URL, Hash, Metadata), 2882 dir_metadata(Info.installed, Metadata).
2883download_data(Info, Data) => 2884 Data = download(URL, Hash, Metadata),
2885 URL = Info.get(downloaded),
2886 download_url(URL),
2887 pack_status_dir(Info.installed, archive(Archive, URL)),
2888 file_sha1(Archive, Hash),
2889 pack_archive_info(Archive, _Pack, Metadata, _).
2890
2895
2896query_pack_server(Query, Result, Options) :-
2897 ( option(server(ServerOpt), Options)
2898 -> server_url(ServerOpt, ServerBase)
2899 ; setting(server, ServerBase),
2900 ServerBase \== ''
2901 ),
2902 atom_concat(ServerBase, query, Server),
2903 format(codes(Data), '~q.~n', Query),
2904 info_level(Informational, Options),
2905 print_message(Informational, pack(contacting_server(Server))),
2906 setup_call_cleanup(
2907 http_open(Server, In,
2908 [ post(codes(application/'x-prolog', Data)),
2909 header(content_type, ContentType)
2910 ]),
2911 read_reply(ContentType, In, Result),
2912 close(In)),
2913 message_severity(Result, Level, Informational),
2914 print_message(Level, pack(server_reply(Result))).
2915
2916server_url(URL0, URL) :-
2917 uri_components(URL0, Components),
2918 uri_data(scheme, Components, Scheme),
2919 var(Scheme),
2920 !,
2921 atom_concat('https://', URL0, URL1),
2922 server_url(URL1, URL).
2923server_url(URL0, URL) :-
2924 uri_components(URL0, Components),
2925 uri_data(path, Components, ''),
2926 !,
2927 uri_edit([path('/pack/')], URL0, URL).
2928server_url(URL, URL).
2929
2930read_reply(ContentType, In, Result) :-
2931 sub_atom(ContentType, 0, _, _, 'application/x-prolog'),
2932 !,
2933 set_stream(In, encoding(utf8)),
2934 read(In, Result).
2935read_reply(ContentType, In, _Result) :-
2936 read_string(In, 500, String),
2937 print_message(error, pack(no_prolog_response(ContentType, String))),
2938 fail.
2939
2940info_level(Level, Options) :-
2941 option(silent(true), Options),
2942 !,
2943 Level = silent.
2944info_level(informational, _).
2945
2946message_severity(true(_), Informational, Informational).
2947message_severity(false, warning, _).
2948message_severity(exception(_), error, _).
2949
2950
2951 2954
2961
2962available_download_versions(URL, Versions) :-
2963 wildcard_pattern(URL),
2964 github_url(URL, User, Repo),
2965 !,
2966 findall(Version-VersionURL,
2967 github_version(User, Repo, Version, VersionURL),
2968 Versions).
2969available_download_versions(URL, Versions) :-
2970 wildcard_pattern(URL),
2971 !,
2972 file_directory_name(URL, DirURL0),
2973 ensure_slash(DirURL0, DirURL),
2974 print_message(informational, pack(query_versions(DirURL))),
2975 setup_call_cleanup(
2976 http_open(DirURL, In, []),
2977 load_html(stream(In), DOM,
2978 [ syntax_errors(quiet)
2979 ]),
2980 close(In)),
2981 findall(MatchingURL,
2982 absolute_matching_href(DOM, URL, MatchingURL),
2983 MatchingURLs),
2984 ( MatchingURLs == []
2985 -> print_message(warning, pack(no_matching_urls(URL)))
2986 ; true
2987 ),
2988 versioned_urls(MatchingURLs, VersionedURLs),
2989 sort_version_pairs(VersionedURLs, Versions),
2990 print_message(informational, pack(found_versions(Versions))).
2991available_download_versions(URL, [Version-URL]) :-
2992 ( pack_version_file(_Pack, Version0, URL)
2993 -> Version = Version0
2994 ; Version = '0.0.0'
2995 ).
2996
3000
3001sort_version_pairs(Pairs, Sorted) :-
3002 map_list_to_pairs(version_pair_sort_key_, Pairs, Keyed),
3003 sort(1, @>=, Keyed, SortedKeyed),
3004 pairs_values(SortedKeyed, Sorted).
3005
3006version_pair_sort_key_(Version-_Data, Key) :-
3007 version_sort_key(Version, Key).
3008
3009version_sort_key(Version, Key) :-
3010 split_string(Version, ".", "", Parts),
3011 maplist(number_string, Key, Parts),
3012 !.
3013version_sort_key(Version, _) :-
3014 domain_error(version, Version).
3015
3019
3020github_url(URL, User, Repo) :-
3021 uri_components(URL, uri_components(https,'github.com',Path,_,_)),
3022 atomic_list_concat(['',User,Repo|_], /, Path).
3023
3024
3029
3030github_version(User, Repo, Version, VersionURI) :-
3031 atomic_list_concat(['',repos,User,Repo,tags], /, Path1),
3032 uri_components(ApiUri, uri_components(https,'api.github.com',Path1,_,_)),
3033 setup_call_cleanup(
3034 http_open(ApiUri, In,
3035 [ request_header('Accept'='application/vnd.github.v3+json')
3036 ]),
3037 json_read_dict(In, Dicts),
3038 close(In)),
3039 member(Dict, Dicts),
3040 atom_string(Tag, Dict.name),
3041 tag_version(Tag, Version),
3042 atom_string(VersionURI, Dict.zipball_url).
3043
3044wildcard_pattern(URL) :- sub_atom(URL, _, _, _, *).
3045wildcard_pattern(URL) :- sub_atom(URL, _, _, _, ?).
3046
3047ensure_slash(Dir, DirS) :-
3048 ( sub_atom(Dir, _, _, 0, /)
3049 -> DirS = Dir
3050 ; atom_concat(Dir, /, DirS)
3051 ).
3052
3053absolute_matching_href(DOM, Pattern, Match) :-
3054 xpath(DOM, //a(@href), HREF),
3055 uri_normalized(HREF, Pattern, Match),
3056 wildcard_match(Pattern, Match).
3057
3058versioned_urls([], []).
3059versioned_urls([H|T0], List) :-
3060 file_base_name(H, File),
3061 ( pack_version_file(_Pack, Version, File)
3062 -> List = [Version-H|T]
3063 ; List = T
3064 ),
3065 versioned_urls(T0, T).
3066
3067
3068 3071
3077
3078pack_provides(Pack, Pack@Version) :-
3079 current_pack(Pack),
3080 once(pack_info(Pack, version, version(Version))).
3081pack_provides(Pack, Provides) :-
3082 findall(Prv, pack_info(Pack, dependency, provides(Prv)), PrvList),
3083 member(Provides, PrvList).
3084
3085pack_requires(Pack, Requires) :-
3086 current_pack(Pack),
3087 findall(Req, pack_info(Pack, dependency, requires(Req)), ReqList),
3088 member(Requires, ReqList).
3089
3090pack_conflicts(Pack, Conflicts) :-
3091 current_pack(Pack),
3092 findall(Cfl, pack_info(Pack, dependency, conflicts(Cfl)), CflList),
3093 member(Conflicts, CflList).
3094
3099
3100pack_depends_on(Pack, Dependency) :-
3101 ground(Pack),
3102 !,
3103 pack_requires(Pack, Requires),
3104 \+ is_prolog_token(Requires),
3105 pack_provides(Dependency, Provides),
3106 satisfies_req(Provides, Requires).
3107pack_depends_on(Pack, Dependency) :-
3108 ground(Dependency),
3109 !,
3110 pack_provides(Dependency, Provides),
3111 pack_requires(Pack, Requires),
3112 satisfies_req(Provides, Requires).
3113pack_depends_on(Pack, Dependency) :-
3114 current_pack(Pack),
3115 pack_depends_on(Pack, Dependency).
3116
3121
3122dependents(Pack, Deps) :-
3123 setof(Dep, dependent(Pack, Dep, []), Deps).
3124
3125dependent(Pack, Dep, Seen) :-
3126 pack_depends_on(Dep0, Pack),
3127 \+ memberchk(Dep0, Seen),
3128 ( Dep = Dep0
3129 ; dependent(Dep0, Dep, [Dep0|Seen])
3130 ).
3131
3135
3136validate_dependencies :-
3137 setof(Issue, pack_dependency_issue(_, Issue), Issues),
3138 !,
3139 print_message(warning, pack(dependency_issues(Issues))).
3140validate_dependencies.
3141
3151
3152pack_dependency_issue(Pack, Issue) :-
3153 current_pack(Pack),
3154 pack_dependency_issue_(Pack, Issue).
3155
3156pack_dependency_issue_(Pack, unsatisfied(Pack, Requires)) :-
3157 pack_requires(Pack, Requires),
3158 ( is_prolog_token(Requires)
3159 -> \+ prolog_satisfies(Requires)
3160 ; \+ ( pack_provides(_, Provides),
3161 satisfies_req(Provides, Requires) )
3162 ).
3163pack_dependency_issue_(Pack, conflicts(Pack, Conflicts)) :-
3164 pack_conflicts(Pack, Conflicts),
3165 ( is_prolog_token(Conflicts)
3166 -> prolog_satisfies(Conflicts)
3167 ; pack_provides(_, Provides),
3168 satisfies_req(Provides, Conflicts)
3169 ).
3170
3171
3172 3175
3189
3190pack_assert(PackDir, Fact) :-
3191 must_be(ground, Fact),
3192 findall(Term, pack_status_dir(PackDir, Term), Facts0),
3193 update_facts(Facts0, Fact, Facts),
3194 OpenOptions = [encoding(utf8), lock(exclusive)],
3195 status_file(PackDir, StatusFile),
3196 ( Facts == Facts0
3197 -> true
3198 ; Facts0 \== [],
3199 append(Facts0, New, Facts)
3200 -> setup_call_cleanup(
3201 open(StatusFile, append, Out, OpenOptions),
3202 maplist(write_fact(Out), New),
3203 close(Out))
3204 ; setup_call_cleanup(
3205 open(StatusFile, write, Out, OpenOptions),
3206 ( write_facts_header(Out),
3207 maplist(write_fact(Out), Facts)
3208 ),
3209 close(Out))
3210 ).
3211
3212update_facts([], Fact, [Fact]) :-
3213 !.
3214update_facts([H|T], Fact, [Fact|T]) :-
3215 general_pack_fact(Fact, GenFact),
3216 general_pack_fact(H, GenTerm),
3217 GenFact =@= GenTerm,
3218 !.
3219update_facts([H|T0], Fact, [H|T]) :-
3220 update_facts(T0, Fact, T).
3221
3222general_pack_fact(built(Arch, _Version, _How), General) =>
3223 General = built(Arch, _, _).
3224general_pack_fact(Term, General), compound(Term) =>
3225 compound_name_arity(Term, Name, Arity),
3226 compound_name_arity(General, Name, Arity).
3227general_pack_fact(Term, General) =>
3228 General = Term.
3229
(Out) :-
3231 format(Out, '% Fact status file. Managed by package manager.~n', []).
3232
3233write_fact(Out, Term) :-
3234 format(Out, '~q.~n', [Term]).
3235
3241
3242pack_status(Pack, Fact) :-
3243 current_pack(Pack, PackDir),
3244 pack_status_dir(PackDir, Fact).
3245
3246pack_status_dir(PackDir, Fact) :-
3247 det_if(ground(Fact), pack_status_(PackDir, Fact)).
3248
3249pack_status_(PackDir, Fact) :-
3250 status_file(PackDir, StatusFile),
3251 catch(term_in_file(valid_term(pack_status_term), StatusFile, Fact),
3252 error(existence_error(source_sink, StatusFile), _),
3253 fail).
3254
3255pack_status_term(built(atom, version, oneof([built,downloaded]))).
3256pack_status_term(automatic(boolean)).
3257pack_status_term(archive(atom, atom)).
3258
3259
3266
3267update_automatic(Info) :-
3268 _ = Info.get(dependency_for),
3269 \+ pack_status(Info.installed, automatic(_)),
3270 !,
3271 pack_assert(Info.installed, automatic(true)).
3272update_automatic(Info) :-
3273 pack_assert(Info.installed, automatic(false)).
3274
3275status_file(PackDir, StatusFile) :-
3276 directory_file_path(PackDir, 'status.db', StatusFile).
3277
3278 3281
3282:- multifile prolog:message//1. 3283
3285
(_Question, _Alternatives, Default, Selection, Options) :-
3287 option(interactive(false), Options),
3288 !,
3289 Selection = Default.
3290menu(Question, Alternatives, Default, Selection, _) :-
3291 length(Alternatives, N),
3292 between(1, 5, _),
3293 print_message(query, Question),
3294 print_menu(Alternatives, Default, 1),
3295 print_message(query, pack(menu(select))),
3296 read_selection(N, Choice),
3297 !,
3298 ( Choice == default
3299 -> Selection = Default
3300 ; nth1(Choice, Alternatives, Selection=_)
3301 -> true
3302 ).
3303
([], _, _).
3305print_menu([Value=Label|T], Default, I) :-
3306 ( Value == Default
3307 -> print_message(query, pack(menu(default_item(I, Label))))
3308 ; print_message(query, pack(menu(item(I, Label))))
3309 ),
3310 I2 is I + 1,
3311 print_menu(T, Default, I2).
3312
3313read_selection(Max, Choice) :-
3314 get_single_char(Code),
3315 ( answered_default(Code)
3316 -> Choice = default
3317 ; code_type(Code, digit(Choice)),
3318 between(1, Max, Choice)
3319 -> true
3320 ; print_message(warning, pack(menu(reply(1,Max)))),
3321 fail
3322 ).
3323
3329
3330confirm(_Question, Default, Options) :-
3331 Default \== none,
3332 option(interactive(false), Options, true),
3333 !,
3334 Default == yes.
3335confirm(Question, Default, _) :-
3336 between(1, 5, _),
3337 print_message(query, pack(confirm(Question, Default))),
3338 read_yes_no(YesNo, Default),
3339 !,
3340 format(user_error, '~N', []),
3341 YesNo == yes.
3342
3343read_yes_no(YesNo, Default) :-
3344 get_single_char(Code),
3345 code_yes_no(Code, Default, YesNo),
3346 !.
3347
3348code_yes_no(0'y, _, yes).
3349code_yes_no(0'Y, _, yes).
3350code_yes_no(0'n, _, no).
3351code_yes_no(0'N, _, no).
3352code_yes_no(_, none, _) :- !, fail.
3353code_yes_no(C, Default, Default) :-
3354 answered_default(C).
3355
3356answered_default(0'\r).
3357answered_default(0'\n).
3358answered_default(0'\s).
3359
3360
3361 3364
3365:- multifile prolog:message//1. 3366
3367prolog:message(pack(Message)) -->
3368 message(Message).
3369
3370:- discontiguous
3371 message//1,
3372 label//1. 3373
3374message(invalid_term(pack_info_term, Term)) -->
3375 [ 'Invalid package meta data: ~q'-[Term] ].
3376message(invalid_term(pack_status_term, Term)) -->
3377 [ 'Invalid package status data: ~q'-[Term] ].
3378message(directory_exists(Dir)) -->
3379 [ 'Package target directory exists and is not empty:', nl,
3380 '\t~q'-[Dir]
3381 ].
3382message(already_installed(pack(Pack, Version))) -->
3383 [ 'Pack `~w'' is already installed @~w'-[Pack, Version] ].
3384message(already_installed(Pack)) -->
3385 [ 'Pack `~w'' is already installed. Package info:'-[Pack] ].
3386message(kept_foreign(Pack, Arch)) -->
3387 [ 'Found foreign libraries for architecture '-[],
3388 ansi(code, '~q', [Arch]), nl,
3389 'Use ', ansi(code, '?- pack_rebuild(~q).', [Pack]),
3390 ' to rebuild from sources'-[]
3391 ].
3392message(no_pack_installed(Pack)) -->
3393 [ 'No pack ~q installed. Use ?- pack_list(Pattern) to search'-[Pack] ].
3394message(dependency_issues(Issues)) -->
3395 [ 'The current set of packs has dependency issues:', nl ],
3396 dep_issues(Issues).
3397message(depends(Pack, Deps)) -->
3398 [ 'The following packs depend on `~w\':'-[Pack], nl ],
3399 pack_list(Deps).
3400message(remove(PackDir)) -->
3401 [ 'Removing ~q and contents'-[PackDir] ].
3402message(remove_existing_pack(PackDir)) -->
3403 [ 'Remove old installation in ~q'-[PackDir] ].
3404message(download_plan(Plan)) -->
3405 [ ansi(bold, 'Installation plan:', []), nl ],
3406 install_plan(Plan, Actions),
3407 install_label(Actions).
3408message(build_plan(Plan)) -->
3409 [ ansi(bold, 'The following packs have post install scripts:', []), nl ],
3410 msg_build_plan(Plan),
3411 [ nl, ansi(bold, 'Run scripts?', []) ].
3412message(no_meta_data(BaseDir)) -->
3413 [ 'Cannot find pack.pl inside directory ~q. Not a package?'-[BaseDir] ].
3414message(search_no_matches(Name)) -->
3415 [ 'Search for "~w", returned no matching packages'-[Name] ].
3416message(rebuild(Pack)) -->
3417 [ 'Checking pack "~w" for rebuild ...'-[Pack] ].
3418message(up_to_date([Pack])) -->
3419 !,
3420 [ 'Pack ' ], msg_pack(Pack), [' is up-to-date' ].
3421message(up_to_date(Packs)) -->
3422 [ 'Packs ' ], sequence(msg_pack, [', '], Packs), [' are up-to-date' ].
3423message(installed_can_upgrade(List)) -->
3424 sequence(msg_can_upgrade_target, [nl], List).
3425message(new_dependencies(Deps)) -->
3426 [ 'Found new dependencies after downloading (~p).'-[Deps], nl ].
3427message(query_versions(URL)) -->
3428 [ 'Querying "~w" to find new versions ...'-[URL] ].
3429message(no_matching_urls(URL)) -->
3430 [ 'Could not find any matching URL: ~q'-[URL] ].
3431message(found_versions([Latest-_URL|More])) -->
3432 { length(More, Len) },
3433 [ ' Latest version: ~w (~D older)'-[Latest, Len] ].
3434message(build(Pack, PackDir)) -->
3435 [ ansi(bold, 'Building pack ~w in directory ~w', [Pack, PackDir]) ].
3436message(contacting_server(Server)) -->
3437 [ 'Contacting server at ~w ...'-[Server], flush ].
3438message(server_reply(true(_))) -->
3439 [ at_same_line, ' ok'-[] ].
3440message(server_reply(false)) -->
3441 [ at_same_line, ' done'-[] ].
3442message(server_reply(exception(E))) -->
3443 [ 'Server reported the following error:'-[], nl ],
3444 '$messages':translate_message(E).
3445message(cannot_create_dir(Alias)) -->
3446 { findall(PackDir,
3447 absolute_file_name(Alias, PackDir, [solutions(all)]),
3448 PackDirs0),
3449 sort(PackDirs0, PackDirs)
3450 },
3451 [ 'Cannot find a place to create a package directory.'-[],
3452 'Considered:'-[]
3453 ],
3454 candidate_dirs(PackDirs).
3455message(conflict(version, [PackV, FileV])) -->
3456 ['Version mismatch: pack.pl: '-[]], msg_version(PackV),
3457 [', file claims version '-[]], msg_version(FileV).
3458message(conflict(name, [PackInfo, FileInfo])) -->
3459 ['Pack ~w mismatch: pack.pl: ~p'-[PackInfo]],
3460 [', file claims ~w: ~p'-[FileInfo]].
3461message(no_prolog_response(ContentType, String)) -->
3462 [ 'Expected Prolog response. Got content of type ~p'-[ContentType], nl,
3463 '~s'-[String]
3464 ].
3465message(download(begin, Pack, _URL, _DownloadFile)) -->
3466 [ 'Downloading ' ], msg_pack(Pack), [ ' ... ', flush ].
3467message(download(end, _, _, File)) -->
3468 { size_file(File, Bytes) },
3469 [ at_same_line, '~D bytes'-[Bytes] ].
3470message(no_git(URL)) -->
3471 [ 'Cannot install from git repository ', url(URL), '.', nl,
3472 'Cannot find git program and do not know how to download the code', nl,
3473 'from this git service. Please install git and retry.'
3474 ].
3475message(git_no_https(GitURL)) -->
3476 [ 'Do not know how to get an HTTP(s) URL for ', url(GitURL) ].
3477message(git_branch_not_default(Dir, Default, Current)) -->
3478 [ 'GIT current branch on ', url(Dir), ' is not default.', nl,
3479 ' Current branch: ', ansi(code, '~w', [Current]),
3480 ' default: ', ansi(code, '~w', [Default])
3481 ].
3482message(git_not_clean(Dir)) -->
3483 [ 'GIT working directory is dirty: ', url(Dir), nl,
3484 'Your repository must be clean before publishing.'
3485 ].
3486message(git_push) -->
3487 [ 'Push release to GIT origin?' ].
3488message(git_tag(Tag)) -->
3489 [ 'Tag repository with release tag ', ansi(code, '~w', [Tag]) ].
3490message(git_release_tag_not_at_head(Tag)) -->
3491 [ 'Release tag ', ansi(code, '~w', [Tag]), ' is not at HEAD.', nl,
3492 'If you want to update the tag, please run ',
3493 ansi(code, 'git tag -d ~w', [Tag])
3494 ].
3495message(git_tag_out_of_sync(Tag)) -->
3496 [ 'Release tag ', ansi(code, '~w', [Tag]),
3497 ' differs from this tag at the origin'
3498 ].
3499
3500message(publish_failed(Info, Reason)) -->
3501 [ 'Pack ' ], msg_pack(Info), [ ' at version ~w'-[Info.version] ],
3502 msg_publish_failed(Reason).
3503
3504msg_publish_failed(throw(error(permission_error(register,
3505 pack(_),_URL),_))) -->
3506 [ ' is already registered with a different URL'].
3507msg_publish_failed(download) -->
3508 [' was already published?'].
3509msg_publish_failed(Status) -->
3510 [ ' failed for unknown reason (~p)'-[Status] ].
3511
3512candidate_dirs([]) --> [].
3513candidate_dirs([H|T]) --> [ nl, ' ~w'-[H] ], candidate_dirs(T).
3514 3515message(resolve_remove) -->
3516 [ nl, 'Please select an action:', nl, nl ].
3517message(create_pack_dir) -->
3518 [ nl, 'Create directory for packages', nl ].
3519message(menu(item(I, Label))) -->
3520 [ '~t(~d)~6| '-[I] ],
3521 label(Label).
3522message(menu(default_item(I, Label))) -->
3523 [ '~t(~d)~6| * '-[I] ],
3524 label(Label).
3525message(menu(select)) -->
3526 [ nl, 'Your choice? ', flush ].
3527message(confirm(Question, Default)) -->
3528 message(Question),
3529 confirm_default(Default),
3530 [ flush ].
3531message(menu(reply(Min,Max))) -->
3532 ( { Max =:= Min+1 }
3533 -> [ 'Please enter ~w or ~w'-[Min,Max] ]
3534 ; [ 'Please enter a number between ~w and ~w'-[Min,Max] ]
3535 ).
3536
3537 3538dep_issues(Issues) -->
3539 sequence(dep_issue, [nl], Issues).
3540
3541dep_issue(unsatisfied(Pack, Requires)) -->
3542 [ ' - Pack ' ], msg_pack(Pack), [' requires ~p'-[Requires]].
3543dep_issue(conflicts(Pack, Conflict)) -->
3544 [ ' - Pack ' ], msg_pack(Pack), [' conflicts with ~p'-[Conflict]].
3545
3550
3551install_label([link]) -->
3552 !,
3553 [ ansi(bold, 'Activate pack?', []) ].
3554install_label([unpack]) -->
3555 !,
3556 [ ansi(bold, 'Unpack archive?', []) ].
3557install_label(_) -->
3558 [ ansi(bold, 'Download packs?', []) ].
3559
3560install_plan([], []) -->
3561 [].
3562install_plan([H|T], [AH|AT]) -->
3563 install_step(H, AH), [nl],
3564 install_plan(T, AT).
3565
3566install_step(Info, keep) -->
3567 { Info.get(keep) == true },
3568 !,
3569 [ ' Keep ' ], msg_pack(Info), [ ' at version ~w'-[Info.version] ],
3570 msg_can_upgrade(Info).
3571install_step(Info, Action) -->
3572 { From = Info.get(upgrade),
3573 VFrom = From.version,
3574 VTo = Info.get(version),
3575 ( cmp_versions(>=, VTo, VFrom)
3576 -> Label = ansi(bold, ' Upgrade ', [])
3577 ; Label = ansi(warning, ' Downgrade ', [])
3578 )
3579 },
3580 [ Label ], msg_pack(Info),
3581 [ ' from version ~w to ~w'- [From.version, Info.get(version)] ],
3582 install_from(Info, Action).
3583install_step(Info, Action) -->
3584 { _From = Info.get(upgrade) },
3585 [ ' Upgrade ' ], msg_pack(Info),
3586 install_from(Info, Action).
3587install_step(Info, Action) -->
3588 { Dep = Info.get(dependency_for) },
3589 [ ' Install ' ], msg_pack(Info),
3590 [ ' at version ~w as dependency for '-[Info.version],
3591 ansi(code, '~w', [Dep])
3592 ],
3593 install_from(Info, Action),
3594 msg_downloads(Info).
3595install_step(Info, Action) -->
3596 { Info.get(commit) == 'HEAD' },
3597 !,
3598 [ ' Install ' ], msg_pack(Info), [ ' at current GIT HEAD'-[] ],
3599 install_from(Info, Action),
3600 msg_downloads(Info).
3601install_step(Info, link) -->
3602 { Info.get(link) == true,
3603 uri_file_name(Info.get(url), Dir)
3604 },
3605 !,
3606 [ ' Install ' ], msg_pack(Info), [ ' as symlink to ', url(Dir) ].
3607install_step(Info, Action) -->
3608 [ ' Install ' ], msg_pack(Info), [ ' at version ~w'-[Info.get(version)] ],
3609 install_from(Info, Action),
3610 msg_downloads(Info).
3611install_step(Info, Action) -->
3612 [ ' Install ' ], msg_pack(Info),
3613 install_from(Info, Action),
3614 msg_downloads(Info).
3615
3616install_from(Info, download) -->
3617 { download_url(Info.url) },
3618 !,
3619 [ ' from ', url(Info.url) ].
3620install_from(Info, unpack) -->
3621 [ ' from ', url(Info.url) ].
3622
3623msg_downloads(Info) -->
3624 { Downloads = Info.get(all_downloads),
3625 Downloads > 0
3626 },
3627 [ ansi(comment, ' (downloaded ~D times)', [Downloads]) ],
3628 !.
3629msg_downloads(_) -->
3630 [].
3631
3632msg_pack(Pack) -->
3633 { atom(Pack) },
3634 !,
3635 [ ansi(code, '~w', [Pack]) ].
3636msg_pack(Info) -->
3637 msg_pack(Info.pack).
3638
3642
3643msg_build_plan(Plan) -->
3644 sequence(build_step, [nl], Plan).
3645
3646build_step(Info) -->
3647 [ ' Build ' ], msg_pack(Info), [' in directory ', url(Info.installed) ].
3648
3649msg_can_upgrade_target(Info) -->
3650 [ ' Pack ' ], msg_pack(Info),
3651 [ ' is installed at version ~w'-[Info.version] ],
3652 msg_can_upgrade(Info).
3653
3654pack_list([]) --> [].
3655pack_list([H|T]) -->
3656 [ ' - Pack ' ], msg_pack(H), [nl],
3657 pack_list(T).
3658
3659label(remove_only(Pack)) -->
3660 [ 'Only remove package ~w (break dependencies)'-[Pack] ].
3661label(remove_deps(Pack, Deps)) -->
3662 { length(Deps, Count) },
3663 [ 'Remove package ~w and ~D dependencies'-[Pack, Count] ].
3664label(create_dir(Dir)) -->
3665 [ '~w'-[Dir] ].
3666label(install_from(git(URL))) -->
3667 !,
3668 [ 'GIT repository at ~w'-[URL] ].
3669label(install_from(URL)) -->
3670 [ '~w'-[URL] ].
3671label(cancel) -->
3672 [ 'Cancel' ].
3673
3674confirm_default(yes) -->
3675 [ ' Y/n? ' ].
3676confirm_default(no) -->
3677 [ ' y/N? ' ].
3678confirm_default(none) -->
3679 [ ' y/n? ' ].
3680
3681msg_version(Version) -->
3682 [ '~w'-[Version] ].
3683
3684msg_can_upgrade(Info) -->
3685 { Latest = Info.get(latest_version) },
3686 [ ansi(warning, ' (can be upgraded to ~w)', [Latest]) ].
3687msg_can_upgrade(_) -->
3688 [].
3689
3690
3691 3694
3695local_uri_file_name(URL, FileName) :-
3696 uri_file_name(URL, FileName),
3697 !.
3698local_uri_file_name(URL, FileName) :-
3699 uri_components(URL, Components),
3700 uri_data(scheme, Components, File), File == file,
3701 uri_data(authority, Components, FileNameEnc),
3702 uri_data(path, Components, ''),
3703 uri_encoded(path, FileName, FileNameEnc).
3704
3705det_if(Cond, Goal) :-
3706 ( Cond
3707 -> Goal,
3708 !
3709 ; Goal
3710 ).
3711
3712member_nonvar(_, Var) :-
3713 var(Var),
3714 !,
3715 fail.
3716member_nonvar(E, [E|_]).
3717member_nonvar(E, [_|T]) :-
3718 member_nonvar(E, T)