35
36:- module(git,
37 [ git/2, 38 git_process_output/3, 39 git_open_file/4, 40 is_git_directory/1, 41 git_describe/2, 42 git_hash/2, 43 git_ls_tree/2, 44 git_remote_url/3, 45 git_ls_remote/3, 46 git_branches/2, 47 git_remote_branches/2, 48 git_default_branch/2, 49 git_tags_on_branch/3, 50 git_shortlog/3, 51 git_log_data/3, 52 git_show/4, 53 git_commit_data/3 54 ]). 55:- use_module(library(process)). 56:- use_module(library(readutil)). 57:- use_module(library(option)). 58:- use_module(library(dcg/basics)). 59:- use_module(library(record)). 60:- use_module(library(lists)). 61:- use_module(library(error)). 62
63:- meta_predicate
64 git_process_output(+, 1, +). 65
76
77:- predicate_options(git/2, 2,
78 [ directory(atom),
79 error(-codes),
80 output(-codes),
81 status(-any),
82 askpass(any)
83 ]). 84:- predicate_options(git_default_branch/2, 2,
85 [ pass_to(git_process_output/3, 3)
86 ] ). 87:- predicate_options(git_describe/2, 2,
88 [ commit(atom),
89 directory(atom),
90 match(atom)
91 ]). 92:- predicate_options(git_hash/2, 2,
93 [ commit(atom),
94 directory(atom)
95 ]). 96:- predicate_options(git_ls_tree/2, 2,
97 [ commit(atom),
98 directory(atom)
99 ]). 100:- predicate_options(git_process_output/3, 3,
101 [ directory(atom),
102 askpass(any),
103 error(-codes)
104 ]). 105:- predicate_options(git_remote_url/3, 3,
106 [ pass_to(git_process_output/3, 3)
107 ]). 108:- predicate_options(git_shortlog/3, 3,
109 [ limit(nonneg),
110 path(atom)
111 ]). 112:- predicate_options(git_show/4, 4,
113 [ diff(oneof([patch,stat]))
114 ]). 115
116
131
132git(Argv, Options) :-
133 option(directory(Dir), Options, .),
134 env_options(Extra, Options),
135 setup_call_cleanup(
136 process_create(path(git), Argv,
137 [ stdout(pipe(Out)),
138 stderr(pipe(Error)),
139 process(PID),
140 cwd(Dir)
141 | Extra
142 ]),
143 call_cleanup(
144 ( read_stream_to_codes(Out, OutCodes, []),
145 read_stream_to_codes(Error, ErrorCodes, [])
146 ),
147 process_wait(PID, Status)),
148 close_streams([Out,Error])),
149 print_error(ErrorCodes, Options),
150 print_output(OutCodes, Options),
151 ( option(status(Status0), Options)
152 -> Status = Status0
153 ; Status == exit(0)
154 -> true
155 ; throw(error(process_error(git(Argv), Status), _))
156 ).
157
158env_options([env(['GIT_ASKPASS'=Program])], Options) :-
159 option(askpass(Exe), Options),
160 !,
161 exe_options(ExeOptions),
162 absolute_file_name(Exe, PlProg, ExeOptions),
163 prolog_to_os_filename(PlProg, Program).
164env_options([], _).
165
166exe_options(Options) :-
167 current_prolog_flag(windows, true),
168 !,
169 Options = [ extensions(['',exe,com]), access(read) ].
170exe_options(Options) :-
171 Options = [ access(execute) ].
172
173print_output(OutCodes, Options) :-
174 option(output(Codes), Options),
175 !,
176 Codes = OutCodes.
177print_output([], _) :- !.
178print_output(OutCodes, _) :-
179 print_message(informational, git(output(OutCodes))).
180
181print_error(OutCodes, Options) :-
182 option(error(Codes), Options),
183 !,
184 Codes = OutCodes.
185print_error([], _) :- !.
186print_error(OutCodes, _) :-
187 phrase(classify_message(Level), OutCodes, _),
188 print_message(Level, git(output(OutCodes))).
189
190classify_message(error) -->
191 string(_), "fatal:",
192 !.
193classify_message(error) -->
194 string(_), "error:",
195 !.
196classify_message(warning) -->
197 string(_), "warning:",
198 !.
199classify_message(informational) -->
200 [].
201
206
207close_streams(List) :-
208 phrase(close_streams(List), Errors),
209 ( Errors = [Error|_]
210 -> throw(Error)
211 ; true
212 ).
213
214close_streams([H|T]) -->
215 { catch(close(H), E, true) },
216 ( { var(E) }
217 -> []
218 ; [E]
219 ),
220 close_streams(T).
221
222
227
228git_process_output(Argv, OnOutput, Options) :-
229 option(directory(Dir), Options, .),
230 env_options(Extra, Options),
231 setup_call_cleanup(
232 process_create(path(git), Argv,
233 [ stdout(pipe(Out)),
234 stderr(pipe(Error)),
235 process(PID),
236 cwd(Dir)
237 | Extra
238 ]),
239 call_cleanup(
240 ( call(OnOutput, Out),
241 read_stream_to_codes(Error, ErrorCodes, [])
242 ),
243 git_wait(PID, Out, Status)),
244 close_streams([Out,Error])),
245 print_error(ErrorCodes, Options),
246 ( Status = exit(0)
247 -> true
248 ; throw(error(process_error(git, Status)))
249 ).
250
251
252git_wait(PID, Out, Status) :-
253 at_end_of_stream(Out),
254 !,
255 process_wait(PID, Status).
256git_wait(PID, Out, Status) :-
257 setup_call_cleanup(
258 open_null_stream(Null),
259 copy_stream_data(Out, Null),
260 close(Null)),
261 process_wait(PID, Status).
262
263
270
271git_open_file(Dir, File, Branch, In) :-
272 atomic_list_concat([Branch, :, File], Ref),
273 process_create(path(git),
274 [ show, Ref ],
275 [ stdout(pipe(In)),
276 cwd(Dir)
277 ]),
278 set_stream(In, file_name(File)).
279
280
285
286is_git_directory(Directory) :-
287 directory_file_path(Directory, '.git', GitDir),
288 exists_directory(GitDir),
289 !.
290is_git_directory(Directory) :-
291 exists_directory(Directory),
292 git(['rev-parse', '--git-dir'],
293 [ output(Codes),
294 error(_),
295 status(Status),
296 directory(Directory)
297 ]),
298 Status == exit(0),
299 string_codes(".\n", Codes).
300
316
317git_describe(Version, Options) :-
318 ( option(match(Pattern), Options)
319 -> true
320 ; git_version_pattern(Pattern)
321 ),
322 ( option(commit(Commit), Options)
323 -> Extra = [Commit]
324 ; Extra = []
325 ),
326 option(directory(Dir), Options, .),
327 setup_call_cleanup(
328 process_create(path(git),
329 [ 'describe',
330 '--match', Pattern
331 | Extra
332 ],
333 [ stdout(pipe(Out)),
334 stderr(null),
335 process(PID),
336 cwd(Dir)
337 ]),
338 call_cleanup(
339 read_stream_to_codes(Out, V0, []),
340 git_wait(PID, Out, Status)),
341 close(Out)),
342 Status = exit(0),
343 !,
344 atom_codes(V1, V0),
345 normalize_space(atom(Plain), V1),
346 ( git_is_clean(Dir)
347 -> Version = Plain
348 ; atom_concat(Plain, '-DIRTY', Version)
349 ).
350git_describe(Version, Options) :-
351 option(directory(Dir), Options, .),
352 option(commit(Commit), Options, 'HEAD'),
353 setup_call_cleanup(
354 process_create(path(git),
355 [ 'rev-parse', '--short',
356 Commit
357 ],
358 [ stdout(pipe(Out)),
359 stderr(null),
360 process(PID),
361 cwd(Dir)
362 ]),
363 call_cleanup(
364 read_stream_to_codes(Out, V0, []),
365 git_wait(PID, Out, Status)),
366 close(Out)),
367 Status = exit(0),
368 atom_codes(V1, V0),
369 normalize_space(atom(Plain), V1),
370 ( git_is_clean(Dir)
371 -> Version = Plain
372 ; atom_concat(Plain, '-DIRTY', Version)
373 ).
374
375
376:- multifile
377 git_version_pattern/1. 378
379git_version_pattern('V*').
380git_version_pattern('*').
381
382
388
389git_is_clean(Dir) :-
390 setup_call_cleanup(process_create(path(git), ['diff', '--stat'],
391 [ stdout(pipe(Out)),
392 stderr(null),
393 cwd(Dir)
394 ]),
395 stream_char_count(Out, Count),
396 close(Out)),
397 Count == 0.
398
399stream_char_count(Out, Count) :-
400 setup_call_cleanup(open_null_stream(Null),
401 ( copy_stream_data(Out, Null),
402 character_count(Null, Count)
403 ),
404 close(Null)).
405
406
410
411git_hash(Hash, Options) :-
412 option(commit(Commit), Options, 'HEAD'),
413 git_process_output(['rev-parse', '--verify', Commit],
414 read_hash(Hash),
415 Options).
416
417read_hash(Hash, Stream) :-
418 read_line_to_codes(Stream, Line),
419 atom_codes(Hash, Line).
420
421
430
431git_ls_tree(Entries, Options) :-
432 option(commit(Commit), Options, 'HEAD'),
433 git_process_output(['ls-tree', '-z', '-r', '-l', Commit],
434 read_tree(Entries),
435 Options).
436
437read_tree(Entries, Stream) :-
438 read_stream_to_codes(Stream, Codes),
439 phrase(ls_tree(Entries), Codes).
440
441ls_tree([H|T]) -->
442 ls_entry(H),
443 !,
444 ls_tree(T).
445ls_tree([]) --> [].
446
447ls_entry(object(Mode, Type, Hash, Size, Name)) -->
448 string(MS), " ",
449 string(TS), " ",
450 string(HS), " ",
451 string(SS), "\t",
452 string(NS), [0],
453 !,
454 { number_codes(Mode, [0'0,0'o|MS]),
455 atom_codes(Type, TS),
456 atom_codes(Hash, HS),
457 ( Type == blob
458 -> number_codes(Size, SS)
459 ; Size = 0 460 ),
461 atom_codes(Name, NS)
462 }.
463
464
468
469git_remote_url(Remote, URL, Options) :-
470 git_process_output([remote, show, Remote],
471 read_url("Fetch URL:", URL),
472 Options).
473
474read_url(Tag, URL, In) :-
475 repeat,
476 read_line_to_codes(In, Line),
477 ( Line == end_of_file
478 -> !, fail
479 ; phrase(url_codes(Tag, Codes), Line)
480 -> !, atom_codes(URL, Codes)
481 ).
482
483url_codes(Tag, Rest) -->
484 { string_codes(Tag, TagCodes) },
485 whites, string(TagCodes), whites, string(Rest).
486
487
506
507git_ls_remote(GitURL, Refs, Options) :-
508 findall(O, ls_remote_option(Options, O), RemoteOptions),
509 option(refs(LimitRefs), Options, []),
510 must_be(list(atom), LimitRefs),
511 append([ 'ls-remote' | RemoteOptions], [GitURL|LimitRefs], Argv),
512 git_process_output(Argv, remote_refs(Refs), []).
513
514ls_remote_option(Options, '--heads') :-
515 option(heads(true), Options).
516ls_remote_option(Options, '--tags') :-
517 option(tags(true), Options).
518
519remote_refs(Refs, Out) :-
520 read_line_to_codes(Out, Line0),
521 remote_refs(Line0, Out, Refs).
522
523remote_refs(end_of_file, _, []) :- !.
524remote_refs(Line, Out, [Hash-Ref|Tail]) :-
525 phrase(remote_ref(Hash,Ref), Line),
526 read_line_to_codes(Out, Line1),
527 remote_refs(Line1, Out, Tail).
528
529remote_ref(Hash, Ref) -->
530 string_without("\t ", HashCodes),
531 whites,
532 string_without("\t ", RefCodes),
533 { atom_codes(Hash, HashCodes),
534 atom_codes(Ref, RefCodes)
535 }.
536
537
542
543git_remote_branches(GitURL, Branches) :-
544 git_ls_remote(GitURL, Refs, [heads(true)]),
545 findall(B, (member(_-Head, Refs),
546 atom_concat('refs/heads/', B, Head)),
547 Branches).
548
549
553
554git_default_branch(BranchName, Options) :-
555 git_process_output([branch],
556 read_default_branch(BranchName),
557 Options).
558
559read_default_branch(BranchName, In) :-
560 repeat,
561 read_line_to_codes(In, Line),
562 ( Line == end_of_file
563 -> !, fail
564 ; phrase(default_branch(Codes), Line)
565 -> !, atom_codes(BranchName, Codes)
566 ).
567
568default_branch(Rest) -->
569 "*", whites, string(Rest).
570
578
579git_branches(Branches, Options) :-
580 ( select_option(commit(Commit), Options, GitOptions)
581 -> Extra = ['--contains', Commit]
582 ; Extra = [],
583 GitOptions = Options
584 ),
585 git_process_output([branch|Extra],
586 read_branches(Branches),
587 GitOptions).
588
589read_branches(Branches, In) :-
590 read_line_to_codes(In, Line),
591 ( Line == end_of_file
592 -> Branches = []
593 ; Line = [_,_|Codes],
594 atom_codes(H, Codes),
595 Branches = [H|T],
596 read_branches(T, In)
597 ).
598
599
606
607git_tags_on_branch(Dir, Branch, Tags) :-
608 git_process_output([ log, '--oneline', '--decorate', Branch ],
609 log_to_tags(Tags),
610 [ directory(Dir) ]).
611
612log_to_tags(Tags, Out) :-
613 read_line_to_codes(Out, Line0),
614 log_to_tags(Line0, Out, Tags, []).
615
616log_to_tags(end_of_file, _, Tags, Tags) :- !.
617log_to_tags(Line, Out, Tags, Tail) :-
618 phrase(tags_on_line(Tags, Tail1), Line),
619 read_line_to_codes(Out, Line1),
620 log_to_tags(Line1, Out, Tail1, Tail).
621
622tags_on_line(Tags, Tail) -->
623 string_without(" ", _Hash),
624 tags(Tags, Tail),
625 skip_rest.
626
627tags(Tags, Tail) -->
628 whites,
629 "(",
630 tag_list(Tags, Rest),
631 !,
632 tags(Rest, Tail).
633tags(Tags, Tags) -->
634 skip_rest.
635
636tag_list([H|T], Rest) -->
637 "tag:", !, whites,
638 string(Codes),
639 ( ")"
640 -> { atom_codes(H, Codes),
641 T = Rest
642 }
643 ; ","
644 -> { atom_codes(H, Codes)
645 },
646 whites,
647 tag_list(T, Rest)
648 ).
649tag_list(List, Rest) -->
650 string(_),
651 ( ")"
652 -> { List = Rest }
653 ; ","
654 -> whites,
655 tag_list(List, Rest)
656 ).
657
658skip_rest(_,_).
659
660
661 664
679
680:- record
681 git_log(commit_hash:atom,
682 author_name:atom,
683 author_date_relative:atom,
684 committer_name:atom,
685 committer_date_relative:atom,
686 committer_date_unix,
687 subject:atom,
688 ref_names:list). 689
690git_shortlog(Dir, ShortLog, Options) :-
691 option(limit(Limit), Options, 10),
692 ( option(git_path(Path), Options)
693 -> Extra = ['--', Path]
694 ; option(path(Path), Options)
695 -> relative_file_name(Path, Dir, RelPath),
696 Extra = ['--', RelPath]
697 ; Extra = []
698 ),
699 git_format_string(git_log, Fields, Format),
700 git_process_output([ log, '-n', Limit, Format
701 | Extra
702 ],
703 read_git_formatted(git_log, Fields, ShortLog),
704 [directory(Dir)]).
705
706
707read_git_formatted(Record, Fields, ShortLog, In) :-
708 read_line_to_codes(In, Line0),
709 read_git_formatted(Line0, In, Record, Fields, ShortLog).
710
711read_git_formatted(end_of_file, _, _, _, []) :- !.
712read_git_formatted(Line, In, Record, Fields, [H|T]) :-
713 record_from_line(Record, Fields, Line, H),
714 read_line_to_codes(In, Line1),
715 read_git_formatted(Line1, In, Record, Fields, T).
716
717record_from_line(RecordName, Fields, Line, Record) :-
718 phrase(fields_from_line(Fields, Values), Line),
719 Record =.. [RecordName|Values].
720
721fields_from_line([], []) --> [].
722fields_from_line([F|FT], [V|VT]) -->
723 to_nul_s(Codes),
724 { field_to_prolog(F, Codes, V) },
725 fields_from_line(FT, VT).
726
727to_nul_s([]) --> [0], !.
728to_nul_s([H|T]) --> [H], to_nul_s(T).
729
730field_to_prolog(ref_names, Line, List) :-
731 phrase(ref_names(List), Line),
732 !.
733field_to_prolog(_, Line, Atom) :-
734 atom_codes(Atom, Line).
735
736ref_names([]) --> [].
737ref_names(List) -->
738 blanks, "(", ref_name_list(List), ")".
739
740ref_name_list([H|T]) -->
741 string_without(",)", Codes),
742 { atom_codes(H, Codes) },
743 ( ",", blanks
744 -> ref_name_list(T)
745 ; {T=[]}
746 ).
747
748
761
762:- record
763 git_commit(tree_hash:atom,
764 parent_hashes:list,
765 author_name:atom,
766 author_date:atom,
767 committer_name:atom,
768 committer_date:atom,
769 subject:atom). 770
771git_show(Dir, Hash, Commit, Options) :-
772 git_format_string(git_commit, Fields, Format),
773 option(diff(Diff), Options, patch),
774 diff_arg(Diff, DiffArg),
775 git_process_output([ show, DiffArg, Hash, Format ],
776 read_commit(Fields, Commit, Options),
777 [directory(Dir)]).
778
779diff_arg(patch, '-p').
780diff_arg(stat, '--stat').
781
782read_commit(Fields, Data-Body, Options, In) :-
783 read_line_to_codes(In, Line1),
784 record_from_line(git_commit, Fields, Line1, Data),
785 read_line_to_codes(In, Line2),
786 ( Line2 == []
787 -> option(max_lines(Max), Options, -1),
788 read_n_lines(In, Max, Body)
789 ; Line2 == end_of_file
790 -> Body = []
791 ).
792
793read_n_lines(In, Max, Lines) :-
794 read_line_to_codes(In, Line1),
795 read_n_lines(Line1, Max, In, Lines).
796
797read_n_lines(end_of_file, _, _, []) :- !.
798read_n_lines(_, 0, In, []) :-
799 !,
800 setup_call_cleanup(open_null_stream(Out),
801 copy_stream_data(In, Out),
802 close(Out)).
803read_n_lines(Line, Max0, In, [Line|More]) :-
804 read_line_to_codes(In, Line2),
805 Max is Max0-1,
806 read_n_lines(Line2, Max, In, More).
807
808
815
816:- meta_predicate
817 git_format_string(:, -, -). 818
819git_format_string(M:RecordName, Fields, Format) :-
820 current_record(RecordName, M:Term),
821 findall(F, record_field(Term, F), Fields),
822 maplist(git_field_format, Fields, Formats),
823 atomic_list_concat(['--format='|Formats], Format).
824
825record_field(Term, Name) :-
826 arg(_, Term, Field),
827 field_name(Field, Name).
828
829field_name(Name:_Type=_Default, Name) :- !.
830field_name(Name:_Type, Name) :- !.
831field_name(Name=_Default, Name) :- !.
832field_name(Name, Name).
833
834git_field_format(Field, Fmt) :-
835 ( git_format(NoPercent, Field)
836 -> atomic_list_concat(['%', NoPercent, '%x00'], Fmt)
837 ; existence_error(git_format, Field)
838 ).
839
840git_format('H', commit_hash).
841git_format('h', abbreviated_commit_hash).
842git_format('T', tree_hash).
843git_format('t', abbreviated_tree_hash).
844git_format('P', parent_hashes).
845git_format('p', abbreviated_parent_hashes).
846
847git_format('an', author_name).
848git_format('aN', author_name_mailcap).
849git_format('ae', author_email).
850git_format('aE', author_email_mailcap).
851git_format('ad', author_date).
852git_format('aD', author_date_rfc2822).
853git_format('ar', author_date_relative).
854git_format('at', author_date_unix).
855git_format('ai', author_date_iso8601).
856
857git_format('cn', committer_name).
858git_format('cN', committer_name_mailcap).
859git_format('ce', committer_email).
860git_format('cE', committer_email_mailcap).
861git_format('cd', committer_date).
862git_format('cD', committer_date_rfc2822).
863git_format('cr', committer_date_relative).
864git_format('ct', committer_date_unix).
865git_format('ci', committer_date_iso8601).
866
867git_format('d', ref_names). 868git_format('e', encoding). 869
870git_format('s', subject).
871git_format('f', subject_sanitized).
872git_format('b', body).
873git_format('N', notes).
874
875git_format('gD', reflog_selector).
876git_format('gd', shortened_reflog_selector).
877git_format('gs', reflog_subject).
878
879
880 883
884:- multifile
885 prolog:message//1. 886
887prolog:message(git(output(Codes))) -->
888 { split_lines(Codes, Lines) },
889 git_lines(Lines).
890
891git_lines([]) --> [].
892git_lines([H|T]) -->
893 [ '~s'-[H] ],
894 ( {T==[]}
895 -> []
896 ; [nl], git_lines(T)
897 ).
898
899split_lines([], []) :- !.
900split_lines(All, [Line1|More]) :-
901 append(Line1, [0'\n|Rest], All),
902 !,
903 split_lines(Rest, More).
904split_lines(Line, [Line])