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(record),[(record)/1,current_record/2, op(_,_,record)]). 56
57:- autoload(library(apply),[maplist/3]). 58:- autoload(library(error),[must_be/2,existence_error/2]). 59:- autoload(library(filesex),
60 [directory_file_path/3,relative_file_name/3]). 61:- autoload(library(lists),[append/3,member/2,append/2]). 62:- autoload(library(option),[option/2,option/3,select_option/3]). 63:- autoload(library(process),[process_create/3,process_wait/2]). 64:- autoload(library(readutil),
65 [ read_stream_to_codes/3,
66 read_line_to_codes/2,
67 read_stream_to_codes/2
68 ]). 69:- autoload(library(dcg/basics),
70 [string//1,whites//0,string_without//2,blanks//0]). 71
72
73:- meta_predicate
74 git_process_output(+, 1, +). 75
86
87:- predicate_options(git/2, 2,
88 [ directory(atom),
89 error(-codes),
90 output(-codes),
91 status(-any),
92 askpass(any)
93 ]). 94:- predicate_options(git_default_branch/2, 2,
95 [ pass_to(git_process_output/3, 3)
96 ] ). 97:- predicate_options(git_describe/2, 2,
98 [ commit(atom),
99 directory(atom),
100 match(atom)
101 ]). 102:- predicate_options(git_hash/2, 2,
103 [ commit(atom),
104 directory(atom)
105 ]). 106:- predicate_options(git_ls_tree/2, 2,
107 [ commit(atom),
108 directory(atom)
109 ]). 110:- predicate_options(git_process_output/3, 3,
111 [ directory(atom),
112 askpass(any),
113 error(-codes)
114 ]). 115:- predicate_options(git_remote_url/3, 3,
116 [ pass_to(git_process_output/3, 3)
117 ]). 118:- predicate_options(git_shortlog/3, 3,
119 [ revisions(atom),
120 limit(nonneg),
121 path(atom)
122 ]). 123:- predicate_options(git_show/4, 4,
124 [ diff(oneof([patch,stat]))
125 ]). 126
127
142
143git(Argv, Options) :-
144 git_cwd_options(Argv, Argv1, Options),
145 env_options(Extra, Options),
146 setup_call_cleanup(
147 process_create(path(git), Argv1,
148 [ stdout(pipe(Out)),
149 stderr(pipe(Error)),
150 process(PID)
151 | Extra
152 ]),
153 call_cleanup(
154 ( read_stream_to_codes(Out, OutCodes, []),
155 read_stream_to_codes(Error, ErrorCodes, [])
156 ),
157 process_wait(PID, Status)),
158 close_streams([Out,Error])),
159 print_error(ErrorCodes, Options),
160 print_output(OutCodes, Options),
161 ( option(status(Status0), Options)
162 -> Status = Status0
163 ; Status == exit(0)
164 -> true
165 ; throw(error(process_error(git(Argv), Status), _))
166 ).
167
168git_cwd_options(Argv0, Argv, Options) :-
169 option(directory(Dir), Options),
170 !,
171 Argv = ['-C', file(Dir) | Argv0 ].
172git_cwd_options(Argv, Argv, _).
173
174env_options([env(['GIT_ASKPASS'=Program])], Options) :-
175 option(askpass(Exe), Options),
176 !,
177 exe_options(ExeOptions),
178 absolute_file_name(Exe, PlProg, ExeOptions),
179 prolog_to_os_filename(PlProg, Program).
180env_options([], _).
181
182exe_options(Options) :-
183 current_prolog_flag(windows, true),
184 !,
185 Options = [ extensions(['',exe,com]), access(read) ].
186exe_options(Options) :-
187 Options = [ access(execute) ].
188
189print_output(OutCodes, Options) :-
190 option(output(Codes), Options),
191 !,
192 Codes = OutCodes.
193print_output([], _) :- !.
194print_output(OutCodes, _) :-
195 print_message(informational, git(output(OutCodes))).
196
197print_error(OutCodes, Options) :-
198 option(error(Codes), Options),
199 !,
200 Codes = OutCodes.
201print_error([], _) :- !.
202print_error(OutCodes, _) :-
203 phrase(classify_message(Level), OutCodes, _),
204 print_message(Level, git(output(OutCodes))).
205
206classify_message(error) -->
207 string(_), "fatal:",
208 !.
209classify_message(error) -->
210 string(_), "error:",
211 !.
212classify_message(warning) -->
213 string(_), "warning:",
214 !.
215classify_message(informational) -->
216 [].
217
222
223close_streams(List) :-
224 phrase(close_streams(List), Errors),
225 ( Errors = [Error|_]
226 -> throw(Error)
227 ; true
228 ).
229
230close_streams([H|T]) -->
231 { catch(close(H), E, true) },
232 ( { var(E) }
233 -> []
234 ; [E]
235 ),
236 close_streams(T).
237
238
243
244git_process_output(Argv, OnOutput, Options) :-
245 git_cwd_options(Argv, Argv1, Options),
246 env_options(Extra, Options),
247 setup_call_cleanup(
248 process_create(path(git), Argv1,
249 [ stdout(pipe(Out)),
250 stderr(pipe(Error)),
251 process(PID)
252 | Extra
253 ]),
254 call_cleanup(
255 ( call(OnOutput, Out),
256 read_stream_to_codes(Error, ErrorCodes, [])
257 ),
258 git_wait(PID, Out, Status)),
259 close_streams([Out,Error])),
260 print_error(ErrorCodes, Options),
261 ( Status = exit(0)
262 -> true
263 ; throw(error(process_error(git, Status)))
264 ).
265
266git_wait(PID, Out, Status) :-
267 at_end_of_stream(Out),
268 !,
269 process_wait(PID, Status).
270git_wait(PID, Out, Status) :-
271 setup_call_cleanup(
272 open_null_stream(Null),
273 copy_stream_data(Out, Null),
274 close(Null)),
275 process_wait(PID, Status).
276
277
284
285git_open_file(Dir, File, Branch, In) :-
286 atomic_list_concat([Branch, :, File], Ref),
287 process_create(path(git),
288 [ '-C', file(Dir), show, Ref ],
289 [ stdout(pipe(In))
290 ]),
291 set_stream(In, file_name(File)).
292
293
298
299is_git_directory(Directory) :-
300 directory_file_path(Directory, '.git', GitDir),
301 exists_directory(GitDir),
302 !.
303is_git_directory(Directory) :-
304 exists_directory(Directory),
305 git(['rev-parse', '--git-dir'],
306 [ output(Codes),
307 error(_),
308 status(Status),
309 directory(Directory)
310 ]),
311 Status == exit(0),
312 string_codes(GitDir0, Codes),
313 split_string(GitDir0, "", " \n", [GitDir]),
314 sub_string(GitDir, B, _, A, "/.git/modules/"),
315 !,
316 sub_string(GitDir, 0, B, _, Main),
317 sub_string(GitDir, _, A, 0, Below),
318 directory_file_path(Main, Below, Dir),
319 same_file(Dir, Directory).
320
336
337git_describe(Version, Options) :-
338 ( option(match(Pattern), Options)
339 -> true
340 ; git_version_pattern(Pattern)
341 ),
342 ( option(commit(Commit), Options)
343 -> Extra = [Commit]
344 ; Extra = []
345 ),
346 option(directory(Dir), Options, .),
347 setup_call_cleanup(
348 process_create(path(git),
349 [ 'describe',
350 '--match', Pattern
351 | Extra
352 ],
353 [ stdout(pipe(Out)),
354 stderr(null),
355 process(PID),
356 cwd(Dir)
357 ]),
358 call_cleanup(
359 read_stream_to_codes(Out, V0, []),
360 git_wait(PID, Out, Status)),
361 close(Out)),
362 Status = exit(0),
363 !,
364 atom_codes(V1, V0),
365 normalize_space(atom(Plain), V1),
366 ( git_is_clean(Dir)
367 -> Version = Plain
368 ; atom_concat(Plain, '-DIRTY', Version)
369 ).
370git_describe(Version, Options) :-
371 option(directory(Dir), Options, .),
372 option(commit(Commit), Options, 'HEAD'),
373 setup_call_cleanup(
374 process_create(path(git),
375 [ 'rev-parse', '--short',
376 Commit
377 ],
378 [ stdout(pipe(Out)),
379 stderr(null),
380 process(PID),
381 cwd(Dir)
382 ]),
383 call_cleanup(
384 read_stream_to_codes(Out, V0, []),
385 git_wait(PID, Out, Status)),
386 close(Out)),
387 Status = exit(0),
388 atom_codes(V1, V0),
389 normalize_space(atom(Plain), V1),
390 ( git_is_clean(Dir)
391 -> Version = Plain
392 ; atom_concat(Plain, '-DIRTY', Version)
393 ).
394
395
396:- multifile
397 git_version_pattern/1. 398
399git_version_pattern('V*').
400git_version_pattern('*').
401
402
408
409git_is_clean(Dir) :-
410 setup_call_cleanup(process_create(path(git), ['diff', '--stat'],
411 [ stdout(pipe(Out)),
412 stderr(null),
413 cwd(Dir)
414 ]),
415 stream_char_count(Out, Count),
416 close(Out)),
417 Count == 0.
418
419stream_char_count(Out, Count) :-
420 setup_call_cleanup(open_null_stream(Null),
421 ( copy_stream_data(Out, Null),
422 character_count(Null, Count)
423 ),
424 close(Null)).
425
426
430
431git_hash(Hash, Options) :-
432 option(commit(Commit), Options, 'HEAD'),
433 git_process_output(['rev-parse', '--verify', Commit],
434 read_hash(Hash),
435 Options).
436
437read_hash(Hash, Stream) :-
438 read_line_to_codes(Stream, Line),
439 atom_codes(Hash, Line).
440
441
450
451git_ls_tree(Entries, Options) :-
452 option(commit(Commit), Options, 'HEAD'),
453 git_process_output(['ls-tree', '-z', '-r', '-l', Commit],
454 read_tree(Entries),
455 Options).
456
457read_tree(Entries, Stream) :-
458 read_stream_to_codes(Stream, Codes),
459 phrase(ls_tree(Entries), Codes).
460
461ls_tree([H|T]) -->
462 ls_entry(H),
463 !,
464 ls_tree(T).
465ls_tree([]) --> [].
466
467ls_entry(object(Mode, Type, Hash, Size, Name)) -->
468 string(MS), " ",
469 string(TS), " ",
470 string(HS), " ",
471 string(SS), "\t",
472 string(NS), [0],
473 !,
474 { number_codes(Mode, [0'0,0'o|MS]),
475 atom_codes(Type, TS),
476 atom_codes(Hash, HS),
477 ( Type == blob
478 -> number_codes(Size, SS)
479 ; Size = 0 480 ),
481 atom_codes(Name, NS)
482 }.
483
484
488
489git_remote_url(Remote, URL, Options) :-
490 git_process_output([remote, show, Remote],
491 read_url("Fetch URL:", URL),
492 Options).
493
494read_url(Tag, URL, In) :-
495 repeat,
496 read_line_to_codes(In, Line),
497 ( Line == end_of_file
498 -> !, fail
499 ; phrase(url_codes(Tag, Codes), Line)
500 -> !, atom_codes(URL, Codes)
501 ).
502
503url_codes(Tag, Rest) -->
504 { string_codes(Tag, TagCodes) },
505 whites, string(TagCodes), whites, string(Rest).
506
507
526
527git_ls_remote(GitURL, Refs, Options) :-
528 findall(O, ls_remote_option(Options, O), RemoteOptions),
529 option(refs(LimitRefs), Options, []),
530 must_be(list(atom), LimitRefs),
531 append([ 'ls-remote' | RemoteOptions], [GitURL|LimitRefs], Argv),
532 git_process_output(Argv, remote_refs(Refs), []).
533
534ls_remote_option(Options, '--heads') :-
535 option(heads(true), Options).
536ls_remote_option(Options, '--tags') :-
537 option(tags(true), Options).
538
539remote_refs(Refs, Out) :-
540 read_line_to_codes(Out, Line0),
541 remote_refs(Line0, Out, Refs).
542
543remote_refs(end_of_file, _, []) :- !.
544remote_refs(Line, Out, [Hash-Ref|Tail]) :-
545 phrase(remote_ref(Hash,Ref), Line),
546 read_line_to_codes(Out, Line1),
547 remote_refs(Line1, Out, Tail).
548
549remote_ref(Hash, Ref) -->
550 string_without("\t ", HashCodes),
551 whites,
552 string_without("\t ", RefCodes),
553 { atom_codes(Hash, HashCodes),
554 atom_codes(Ref, RefCodes)
555 }.
556
557
562
563git_remote_branches(GitURL, Branches) :-
564 git_ls_remote(GitURL, Refs, [heads(true)]),
565 findall(B, (member(_-Head, Refs),
566 atom_concat('refs/heads/', B, Head)),
567 Branches).
568
569
573
574git_default_branch(BranchName, Options) :-
575 git_process_output([branch],
576 read_default_branch(BranchName),
577 Options).
578
579read_default_branch(BranchName, In) :-
580 repeat,
581 read_line_to_codes(In, Line),
582 ( Line == end_of_file
583 -> !, fail
584 ; phrase(default_branch(Codes), Line)
585 -> !, atom_codes(BranchName, Codes)
586 ).
587
588default_branch(Rest) -->
589 "*", whites, string(Rest).
590
598
599git_branches(Branches, Options) :-
600 ( select_option(commit(Commit), Options, GitOptions)
601 -> Extra = ['--contains', Commit]
602 ; Extra = [],
603 GitOptions = Options
604 ),
605 git_process_output([branch|Extra],
606 read_branches(Branches),
607 GitOptions).
608
609read_branches(Branches, In) :-
610 read_line_to_codes(In, Line),
611 ( Line == end_of_file
612 -> Branches = []
613 ; Line = [_,_|Codes],
614 atom_codes(H, Codes),
615 Branches = [H|T],
616 read_branches(T, In)
617 ).
618
619
626
627git_tags_on_branch(Dir, Branch, Tags) :-
628 git_process_output([ log, '--oneline', '--decorate', Branch ],
629 log_to_tags(Tags),
630 [ directory(Dir) ]).
631
632log_to_tags(Tags, Out) :-
633 read_line_to_codes(Out, Line0),
634 log_to_tags(Line0, Out, Tags, []).
635
636log_to_tags(end_of_file, _, Tags, Tags) :- !.
637log_to_tags(Line, Out, Tags, Tail) :-
638 phrase(tags_on_line(Tags, Tail1), Line),
639 read_line_to_codes(Out, Line1),
640 log_to_tags(Line1, Out, Tail1, Tail).
641
642tags_on_line(Tags, Tail) -->
643 string_without(" ", _Hash),
644 tags(Tags, Tail),
645 skip_rest.
646
647tags(Tags, Tail) -->
648 whites,
649 "(",
650 tag_list(Tags, Rest),
651 !,
652 tags(Rest, Tail).
653tags(Tags, Tags) -->
654 skip_rest.
655
656tag_list([H|T], Rest) -->
657 "tag:", !, whites,
658 string(Codes),
659 ( ")"
660 -> { atom_codes(H, Codes),
661 T = Rest
662 }
663 ; ","
664 -> { atom_codes(H, Codes)
665 },
666 whites,
667 tag_list(T, Rest)
668 ).
669tag_list(List, Rest) -->
670 string(_),
671 ( ")"
672 -> { List = Rest }
673 ; ","
674 -> whites,
675 tag_list(List, Rest)
676 ).
677
678skip_rest(_,_).
679
680
681 684
701
702:- record
703 git_log(commit_hash:atom,
704 author_name:atom,
705 author_date_relative:atom,
706 committer_name:atom,
707 committer_date_relative:atom,
708 committer_date_unix:integer,
709 subject:atom,
710 ref_names:list). 711
712git_shortlog(Dir, ShortLog, Options) :-
713 ( option(revisions(Range), Options)
714 -> RangeSpec = [Range]
715 ; option(limit(Limit), Options, 10),
716 RangeSpec = ['-n', Limit]
717 ),
718 ( option(git_path(Path), Options)
719 -> Extra = ['--', Path]
720 ; option(path(Path), Options)
721 -> relative_file_name(Path, Dir, RelPath),
722 Extra = ['--', RelPath]
723 ; Extra = []
724 ),
725 git_format_string(git_log, Fields, Format),
726 append([[log, Format], RangeSpec, Extra], GitArgv),
727 git_process_output(GitArgv,
728 read_git_formatted(git_log, Fields, ShortLog),
729 [directory(Dir)]).
730
731
732read_git_formatted(Record, Fields, ShortLog, In) :-
733 read_line_to_codes(In, Line0),
734 read_git_formatted(Line0, In, Record, Fields, ShortLog).
735
736read_git_formatted(end_of_file, _, _, _, []) :- !.
737read_git_formatted(Line, In, Record, Fields, [H|T]) :-
738 record_from_line(Record, Fields, Line, H),
739 read_line_to_codes(In, Line1),
740 read_git_formatted(Line1, In, Record, Fields, T).
741
742record_from_line(RecordName, Fields, Line, Record) :-
743 phrase(fields_from_line(Fields, Values), Line),
744 Record =.. [RecordName|Values].
745
746fields_from_line([], []) --> [].
747fields_from_line([F|FT], [V|VT]) -->
748 to_nul_s(Codes),
749 { field_to_prolog(F, Codes, V) },
750 fields_from_line(FT, VT).
751
752to_nul_s([]) --> [0], !.
753to_nul_s([H|T]) --> [H], to_nul_s(T).
754
755field_to_prolog(ref_names, Line, List) :-
756 phrase(ref_names(List), Line),
757 !.
758field_to_prolog(committer_date_unix, Line, Stamp) :-
759 !,
760 number_codes(Stamp, Line).
761field_to_prolog(_, Line, Atom) :-
762 atom_codes(Atom, Line).
763
764ref_names([]) --> [].
765ref_names(List) -->
766 blanks, "(", ref_name_list(List), ")".
767
768ref_name_list([H|T]) -->
769 string_without(",)", Codes),
770 { atom_codes(H, Codes) },
771 ( ",", blanks
772 -> ref_name_list(T)
773 ; {T=[]}
774 ).
775
776
789
790:- record
791 git_commit(tree_hash:atom,
792 parent_hashes:list,
793 author_name:atom,
794 author_date:atom,
795 committer_name:atom,
796 committer_date:atom,
797 subject:atom). 798
799git_show(Dir, Hash, Commit, Options) :-
800 git_format_string(git_commit, Fields, Format),
801 option(diff(Diff), Options, patch),
802 diff_arg(Diff, DiffArg),
803 git_process_output([ show, DiffArg, Hash, Format ],
804 read_commit(Fields, Commit, Options),
805 [directory(Dir)]).
806
807diff_arg(patch, '-p').
808diff_arg(stat, '--stat').
809
810read_commit(Fields, Data-Body, Options, In) :-
811 read_line_to_codes(In, Line1),
812 record_from_line(git_commit, Fields, Line1, Data),
813 read_line_to_codes(In, Line2),
814 ( Line2 == []
815 -> option(max_lines(Max), Options, -1),
816 read_n_lines(In, Max, Body)
817 ; Line2 == end_of_file
818 -> Body = []
819 ).
820
821read_n_lines(In, Max, Lines) :-
822 read_line_to_codes(In, Line1),
823 read_n_lines(Line1, Max, In, Lines).
824
825read_n_lines(end_of_file, _, _, []) :- !.
826read_n_lines(_, 0, In, []) :-
827 !,
828 setup_call_cleanup(open_null_stream(Out),
829 copy_stream_data(In, Out),
830 close(Out)).
831read_n_lines(Line, Max0, In, [Line|More]) :-
832 read_line_to_codes(In, Line2),
833 Max is Max0-1,
834 read_n_lines(Line2, Max, In, More).
835
836
843
844:- meta_predicate
845 git_format_string(:, -, -). 846
847git_format_string(M:RecordName, Fields, Format) :-
848 current_record(RecordName, M:Term),
849 findall(F, record_field(Term, F), Fields),
850 maplist(git_field_format, Fields, Formats),
851 atomic_list_concat(['--format='|Formats], Format).
852
853record_field(Term, Name) :-
854 arg(_, Term, Field),
855 field_name(Field, Name).
856
857field_name(Name:_Type=_Default, Name) :- !.
858field_name(Name:_Type, Name) :- !.
859field_name(Name=_Default, Name) :- !.
860field_name(Name, Name).
861
862git_field_format(Field, Fmt) :-
863 ( git_format(NoPercent, Field)
864 -> atomic_list_concat(['%', NoPercent, '%x00'], Fmt)
865 ; existence_error(git_format, Field)
866 ).
867
868git_format('H', commit_hash).
869git_format('h', abbreviated_commit_hash).
870git_format('T', tree_hash).
871git_format('t', abbreviated_tree_hash).
872git_format('P', parent_hashes).
873git_format('p', abbreviated_parent_hashes).
874
875git_format('an', author_name).
876git_format('aN', author_name_mailcap).
877git_format('ae', author_email).
878git_format('aE', author_email_mailcap).
879git_format('ad', author_date).
880git_format('aD', author_date_rfc2822).
881git_format('ar', author_date_relative).
882git_format('at', author_date_unix).
883git_format('ai', author_date_iso8601).
884
885git_format('cn', committer_name).
886git_format('cN', committer_name_mailcap).
887git_format('ce', committer_email).
888git_format('cE', committer_email_mailcap).
889git_format('cd', committer_date).
890git_format('cD', committer_date_rfc2822).
891git_format('cr', committer_date_relative).
892git_format('ct', committer_date_unix).
893git_format('ci', committer_date_iso8601).
894
895git_format('d', ref_names). 896git_format('e', encoding). 897
898git_format('s', subject).
899git_format('f', subject_sanitized).
900git_format('b', body).
901git_format('N', notes).
902
903git_format('gD', reflog_selector).
904git_format('gd', shortened_reflog_selector).
905git_format('gs', reflog_subject).
906
907
908 911
912:- multifile
913 prolog:message//1. 914
915prolog:message(git(output(Codes))) -->
916 { split_lines(Codes, Lines) },
917 git_lines(Lines).
918
919git_lines([]) --> [].
920git_lines([H|T]) -->
921 [ '~s'-[H] ],
922 ( {T==[]}
923 -> []
924 ; [nl], git_lines(T)
925 ).
926
927split_lines([], []) :- !.
928split_lines(All, [Line1|More]) :-
929 append(Line1, [0'\n|Rest], All),
930 !,
931 split_lines(Rest, More).
932split_lines(Line, [Line])