1/*  Part of SWI-Prolog
   2
   3    Author:        Jan Wielemaker
   4    E-mail:        J.Wielemaker@vu.nl
   5    WWW:           http://www.swi-prolog.org
   6    Copyright (c) 2010-2013, University of Amsterdam,
   7                             VU University
   8    Amsterdam All rights reserved.
   9
  10    Redistribution and use in source and binary forms, with or without
  11    modification, are permitted provided that the following conditions
  12    are met:
  13
  14    1. Redistributions of source code must retain the above copyright
  15       notice, this list of conditions and the following disclaimer.
  16
  17    2. Redistributions in binary form must reproduce the above copyright
  18       notice, this list of conditions and the following disclaimer in
  19       the documentation and/or other materials provided with the
  20       distribution.
  21
  22    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
  23    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
  24    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
  25    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
  26    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
  27    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
  28    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
  29    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
  30    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
  31    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
  32    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
  33    POSSIBILITY OF SUCH DAMAGE.
  34*/
  35
  36:- module(git,
  37          [ git/2,                      % +Argv, +Options
  38            git_process_output/3,       % +Argv, :OnOutput, +Options
  39            git_open_file/4,            % +Dir, +File, +Branch, -Stream
  40            is_git_directory/1,         % +Dir
  41            git_describe/2,             % -Version, +Options
  42            git_hash/2,                 % -Hash, +Options
  43            git_ls_tree/2,              % -Content, +Options
  44            git_remote_url/3,           % +Remote, -URL, +Options
  45            git_ls_remote/3,            % +GitURL, -Refs, +Options
  46            git_branches/2,             % -Branches, +Options
  47            git_remote_branches/2,      % +GitURL, -Branches
  48            git_default_branch/2,       % -DefaultBranch, +Options
  49            git_tags_on_branch/3,       % +Dir, +Branch, -Tags
  50            git_shortlog/3,             % +Dir, -Shortlog, +Options
  51            git_log_data/3,             % +Field, +Record, -Value
  52            git_show/4,                 % +Dir, +Hash, -Commit, +Options
  53            git_commit_data/3           % +Field, +Record, -Value
  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
  66/** <module> Run GIT commands
  67
  68This module performs common GIT tasks by calling git as a remote process
  69through process_create/3. It requires that the =git= executable is in the
  70current PATH.
  71
  72This module started life in ClioPatria and   has been used by the Prolog
  73web-server to provide information on git   repositories. It is now moved
  74into the core Prolog library to support the Prolog package manager.
  75*/
  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
 117%!  git(+Argv, +Options) is det.
 118%
 119%   Run a GIT command.  Defined options:
 120%
 121%     * directory(+Dir)
 122%     Execute in the given directory
 123%     * output(-Out)
 124%     Unify Out with a list of codes representing stdout of the
 125%     command.  Otherwise the output is handed to print_message/2
 126%     with level =informational=.
 127%     * error(-Error)
 128%     As output(Out), but messages are printed at level =error=.
 129%     * askpass(+Program)
 130%     Export GIT_ASKPASS=Program
 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
 202%!  close_streams(+Streams:list) is det.
 203%
 204%   Close a list of streams, throwing the first error if some stream
 205%   failed to close.
 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
 223%!  git_process_output(+Argv, :OnOutput, +Options) is det.
 224%
 225%   Run a git-command and process the output with OnOutput, which is
 226%   called as call(OnOutput, Stream).
 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            process_wait(PID, 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
 252%!  git_open_file(+GitRepoDir, +File, +Branch, -Stream) is det.
 253%
 254%   Open the file File in the given bare GIT repository on the given
 255%   branch (treeisch).
 256%
 257%   @bug    We cannot tell whether opening failed for some reason.
 258
 259git_open_file(Dir, File, Branch, In) :-
 260    atomic_list_concat([Branch, :, File], Ref),
 261    process_create(path(git),
 262                   [ show, Ref ],
 263                   [ stdout(pipe(In)),
 264                     cwd(Dir)
 265                   ]),
 266    set_stream(In, file_name(File)).
 267
 268
 269%!  is_git_directory(+Directory) is semidet.
 270%
 271%   True if Directory is a  git   directory  (Either  checked out or
 272%   bare).
 273
 274is_git_directory(Directory) :-
 275    directory_file_path(Directory, '.git', GitDir),
 276    exists_directory(GitDir),
 277    !.
 278is_git_directory(Directory) :-
 279    exists_directory(Directory),
 280    git(['rev-parse', '--git-dir'],
 281        [ output(Codes),
 282          error(_),
 283          status(Status),
 284          directory(Directory)
 285        ]),
 286    Status == exit(0),
 287    string_codes(".\n", Codes).
 288
 289%!  git_describe(-Version, +Options) is semidet.
 290%
 291%   Describe the running version  based  on   GIT  tags  and hashes.
 292%   Options:
 293%
 294%       * match(+Pattern)
 295%       Only use tags that match Pattern (a Unix glob-pattern; e.g.
 296%       =|V*|=)
 297%       * directory(Dir)
 298%       Provide the version-info for a directory that is part of
 299%       a GIT-repository.
 300%       * commit(+Commit)
 301%       Describe Commit rather than =HEAD=
 302%
 303%   @see git describe
 304
 305git_describe(Version, Options) :-
 306    (   option(match(Pattern), Options)
 307    ->  true
 308    ;   git_version_pattern(Pattern)
 309    ),
 310    (   option(commit(Commit), Options)
 311    ->  Extra = [Commit]
 312    ;   Extra = []
 313    ),
 314    option(directory(Dir), Options, .),
 315    setup_call_cleanup(
 316        process_create(path(git),
 317                       [ 'describe',
 318                         '--match', Pattern
 319                       | Extra
 320                       ],
 321                       [ stdout(pipe(Out)),
 322                         stderr(null),
 323                         process(PID),
 324                         cwd(Dir)
 325                       ]),
 326        call_cleanup(
 327            read_stream_to_codes(Out, V0, []),
 328            process_wait(PID, Status)),
 329        close(Out)),
 330    Status = exit(0),
 331    !,
 332    atom_codes(V1, V0),
 333    normalize_space(atom(Plain), V1),
 334    (   git_is_clean(Dir)
 335    ->  Version = Plain
 336    ;   atom_concat(Plain, '-DIRTY', Version)
 337    ).
 338git_describe(Version, Options) :-
 339    option(directory(Dir), Options, .),
 340    option(commit(Commit), Options, 'HEAD'),
 341    setup_call_cleanup(
 342        process_create(path(git),
 343                       [ 'rev-parse', '--short',
 344                         Commit
 345                       ],
 346                       [ stdout(pipe(Out)),
 347                         stderr(null),
 348                         process(PID),
 349                         cwd(Dir)
 350                       ]),
 351        call_cleanup(
 352            read_stream_to_codes(Out, V0, []),
 353            process_wait(PID, Status)),
 354        close(Out)),
 355    Status = exit(0),
 356    atom_codes(V1, V0),
 357    normalize_space(atom(Plain), V1),
 358    (   git_is_clean(Dir)
 359    ->  Version = Plain
 360    ;   atom_concat(Plain, '-DIRTY', Version)
 361    ).
 362
 363
 364:- multifile
 365    git_version_pattern/1.
 366
 367git_version_pattern('V*').
 368git_version_pattern('*').
 369
 370
 371%!  git_is_clean(+Dir) is semidet.
 372%
 373%   True if the given directory is in   a git module and this module
 374%   is clean. To us, clean only   implies that =|git diff|= produces
 375%   no output.
 376
 377git_is_clean(Dir) :-
 378    setup_call_cleanup(process_create(path(git), ['diff', '--stat'],
 379                                      [ stdout(pipe(Out)),
 380                                        stderr(null),
 381                                        cwd(Dir)
 382                                      ]),
 383                       stream_char_count(Out, Count),
 384                       close(Out)),
 385    Count == 0.
 386
 387stream_char_count(Out, Count) :-
 388    setup_call_cleanup(open_null_stream(Null),
 389                       (   copy_stream_data(Out, Null),
 390                           character_count(Null, Count)
 391                       ),
 392                       close(Null)).
 393
 394
 395%!  git_hash(-Hash, +Options) is det.
 396%
 397%   Return the hash of the indicated object.
 398
 399git_hash(Hash, Options) :-
 400    option(commit(Commit), Options, 'HEAD'),
 401    git_process_output(['rev-parse', '--verify', Commit],
 402                       read_hash(Hash),
 403                       Options).
 404
 405read_hash(Hash, Stream) :-
 406    read_line_to_codes(Stream, Line),
 407    atom_codes(Hash, Line).
 408
 409
 410%!  git_ls_tree(-Entries, +Options) is det.
 411%
 412%   True  when  Entries  is  a  list  of  entries  in  the  the  GIT
 413%   repository, Each entry is a term:
 414%
 415%     ==
 416%     object(Mode, Type, Hash, Size, Name)
 417%     ==
 418
 419git_ls_tree(Entries, Options) :-
 420    option(commit(Commit), Options, 'HEAD'),
 421    git_process_output(['ls-tree', '-z', '-r', '-l', Commit],
 422                       read_tree(Entries),
 423                       Options).
 424
 425read_tree(Entries, Stream) :-
 426    read_stream_to_codes(Stream, Codes),
 427    phrase(ls_tree(Entries), Codes).
 428
 429ls_tree([H|T]) -->
 430    ls_entry(H),
 431    !,
 432    ls_tree(T).
 433ls_tree([]) --> [].
 434
 435ls_entry(object(Mode, Type, Hash, Size, Name)) -->
 436    string(MS), " ",
 437    string(TS), " ",
 438    string(HS), " ",
 439    string(SS), "\t",
 440    string(NS), [0],
 441    !,
 442    { number_codes(Mode, [0'0,0'o|MS]),
 443      atom_codes(Type, TS),
 444      atom_codes(Hash, HS),
 445      (   Type == blob
 446      ->  number_codes(Size, SS)
 447      ;   Size = 0          % actually '-', but 0 sums easier
 448      ),
 449      atom_codes(Name, NS)
 450    }.
 451
 452
 453%!  git_remote_url(+Remote, -URL, +Options) is det.
 454%
 455%   URL is the remote (fetch) URL for the given Remote.
 456
 457git_remote_url(Remote, URL, Options) :-
 458    git_process_output([remote, show, Remote],
 459                       read_url("Fetch URL:", URL),
 460                       Options).
 461
 462read_url(Tag, URL, In) :-
 463    repeat,
 464        read_line_to_codes(In, Line),
 465        (   Line == end_of_file
 466        ->  !, fail
 467        ;   phrase(url_codes(Tag, Codes), Line)
 468        ->  !, atom_codes(URL, Codes)
 469        ).
 470
 471url_codes(Tag, Rest) -->
 472    { string_codes(Tag, TagCodes) },
 473    whites, string(TagCodes), whites, string(Rest).
 474
 475
 476%!  git_ls_remote(+GitURL, -Refs, +Options) is det.
 477%
 478%   Execute =|git ls-remote|= against the remote repository to fetch
 479%   references from the remote.  Options processed:
 480%
 481%     * heads(Boolean)
 482%     * tags(Boolean)
 483%     * refs(List)
 484%
 485%   For example, to find the hash of the remote =HEAD=, one can use
 486%
 487%     ==
 488%     ?- git_ls_remote('git://www.swi-prolog.org/home/pl/git/pl-devel.git',
 489%                      Refs, [refs(['HEAD'])]).
 490%     Refs = ['5d596c52aa969d88e7959f86327f5c7ff23695f3'-'HEAD'].
 491%     ==
 492%
 493%   @param Refs is a list of pairs hash-name.
 494
 495git_ls_remote(GitURL, Refs, Options) :-
 496    findall(O, ls_remote_option(Options, O), RemoteOptions),
 497    option(refs(LimitRefs), Options, []),
 498    must_be(list(atom), LimitRefs),
 499    append([ 'ls-remote' | RemoteOptions], [GitURL|LimitRefs], Argv),
 500    git_process_output(Argv, remote_refs(Refs), []).
 501
 502ls_remote_option(Options, '--heads') :-
 503    option(heads(true), Options).
 504ls_remote_option(Options, '--tags') :-
 505    option(tags(true), Options).
 506
 507remote_refs(Refs, Out) :-
 508    read_line_to_codes(Out, Line0),
 509    remote_refs(Line0, Out, Refs).
 510
 511remote_refs(end_of_file, _, []) :- !.
 512remote_refs(Line, Out, [Hash-Ref|Tail]) :-
 513    phrase(remote_ref(Hash,Ref), Line),
 514    read_line_to_codes(Out, Line1),
 515    remote_refs(Line1, Out, Tail).
 516
 517remote_ref(Hash, Ref) -->
 518    string_without("\t ", HashCodes),
 519    whites,
 520    string_without("\t ", RefCodes),
 521    { atom_codes(Hash, HashCodes),
 522      atom_codes(Ref, RefCodes)
 523    }.
 524
 525
 526%!  git_remote_branches(+GitURL, -Branches) is det.
 527%
 528%   Exploit git_ls_remote/3 to fetch  the   branches  from  a remote
 529%   repository without downloading it.
 530
 531git_remote_branches(GitURL, Branches) :-
 532    git_ls_remote(GitURL, Refs, [heads(true)]),
 533    findall(B, (member(_-Head, Refs),
 534                atom_concat('refs/heads/', B, Head)),
 535            Branches).
 536
 537
 538%!  git_default_branch(-BranchName, +Options) is det.
 539%
 540%   True when BranchName is the default branch of a repository.
 541
 542git_default_branch(BranchName, Options) :-
 543    git_process_output([branch],
 544                       read_default_branch(BranchName),
 545                       Options).
 546
 547read_default_branch(BranchName, In) :-
 548    repeat,
 549        read_line_to_codes(In, Line),
 550        (   Line == end_of_file
 551        ->  !, fail
 552        ;   phrase(default_branch(Codes), Line)
 553        ->  !, atom_codes(BranchName, Codes)
 554        ).
 555
 556default_branch(Rest) -->
 557    "*", whites, string(Rest).
 558
 559%!  git_branches(-Branches, +Options) is det.
 560%
 561%   True when Branches is the list of branches in the repository.
 562%   In addition to the usual options, this processes:
 563%
 564%     - contains(Commit)
 565%     Return only branches that contain Commit.
 566
 567git_branches(Branches, Options) :-
 568    (   select_option(commit(Commit), Options, GitOptions)
 569    ->  Extra = ['--contains', Commit]
 570    ;   Extra = [],
 571        GitOptions = Options
 572    ),
 573    git_process_output([branch|Extra],
 574                       read_branches(Branches),
 575                       GitOptions).
 576
 577read_branches(Branches, In) :-
 578    read_line_to_codes(In, Line),
 579    (   Line == end_of_file
 580    ->  Branches = []
 581    ;   Line = [_,_|Codes],
 582        atom_codes(H, Codes),
 583        Branches = [H|T],
 584        read_branches(T, In)
 585    ).
 586
 587
 588%!  git_tags_on_branch(+Dir, +Branch, -Tags) is det.
 589%
 590%   Tags is a list of tags in Branch on the GIT repository Dir, most
 591%   recent tag first.
 592%
 593%   @see Git tricks at http://mislav.uniqpath.com/2010/07/git-tips/
 594
 595git_tags_on_branch(Dir, Branch, Tags) :-
 596    git_process_output([ log, '--oneline', '--decorate', Branch ],
 597                       log_to_tags(Tags),
 598                       [ directory(Dir) ]).
 599
 600log_to_tags(Tags, Out) :-
 601    read_line_to_codes(Out, Line0),
 602    log_to_tags(Line0, Out, Tags, []).
 603
 604log_to_tags(end_of_file, _, Tags, Tags) :- !.
 605log_to_tags(Line, Out, Tags, Tail) :-
 606    phrase(tags_on_line(Tags, Tail1), Line),
 607    read_line_to_codes(Out, Line1),
 608    log_to_tags(Line1, Out, Tail1, Tail).
 609
 610tags_on_line(Tags, Tail) -->
 611    string_without(" ", _Hash),
 612    tags(Tags, Tail),
 613    skip_rest.
 614
 615tags(Tags, Tail) -->
 616    whites,
 617    "(",
 618    tag_list(Tags, Rest),
 619    !,
 620    tags(Rest, Tail).
 621tags(Tags, Tags) -->
 622    skip_rest.
 623
 624tag_list([H|T], Rest) -->
 625    "tag:", !, whites,
 626    string(Codes),
 627    (   ")"
 628    ->  { atom_codes(H, Codes),
 629          T = Rest
 630        }
 631    ;   ","
 632    ->  { atom_codes(H, Codes)
 633        },
 634        whites,
 635        tag_list(T, Rest)
 636    ).
 637tag_list(List, Rest) -->
 638    string(_),
 639    (   ")"
 640    ->  { List = Rest }
 641    ;   ","
 642    ->  whites,
 643        tag_list(List, Rest)
 644    ).
 645
 646skip_rest(_,_).
 647
 648
 649                 /*******************************
 650                 *        READ GIT HISTORY      *
 651                 *******************************/
 652
 653%!  git_shortlog(+Dir, -ShortLog, +Options) is det.
 654%
 655%   Fetch information like the  GitWeb   change  overview. Processed
 656%   options:
 657%
 658%       * limit(+Count)
 659%       Maximum number of commits to show (default is 10)
 660%       * path(+Path)
 661%       Only show commits that affect Path.  Path is the path of
 662%       a checked out file.
 663%       * git_path(+Path)
 664%       Similar to =path=, but Path is relative to the repository.
 665%
 666%   @param ShortLog is a list of =git_log= records.
 667
 668:- record
 669    git_log(commit_hash:atom,
 670            author_name:atom,
 671            author_date_relative:atom,
 672            committer_name:atom,
 673            committer_date_relative:atom,
 674            committer_date_unix,
 675            subject:atom,
 676            ref_names:list).
 677
 678git_shortlog(Dir, ShortLog, Options) :-
 679    option(limit(Limit), Options, 10),
 680    (   option(git_path(Path), Options)
 681    ->  Extra = ['--', Path]
 682    ;   option(path(Path), Options)
 683    ->  relative_file_name(Path, Dir, RelPath),
 684        Extra = ['--', RelPath]
 685    ;   Extra = []
 686    ),
 687    git_format_string(git_log, Fields, Format),
 688    git_process_output([ log, '-n', Limit, Format
 689                       | Extra
 690                       ],
 691                       read_git_formatted(git_log, Fields, ShortLog),
 692                       [directory(Dir)]).
 693
 694
 695read_git_formatted(Record, Fields, ShortLog, In) :-
 696    read_line_to_codes(In, Line0),
 697    read_git_formatted(Line0, In, Record, Fields, ShortLog).
 698
 699read_git_formatted(end_of_file, _, _, _, []) :- !.
 700read_git_formatted(Line, In, Record, Fields, [H|T]) :-
 701    record_from_line(Record, Fields, Line, H),
 702    read_line_to_codes(In, Line1),
 703    read_git_formatted(Line1, In, Record, Fields, T).
 704
 705record_from_line(RecordName, Fields, Line, Record) :-
 706    phrase(fields_from_line(Fields, Values), Line),
 707    Record =.. [RecordName|Values].
 708
 709fields_from_line([], []) --> [].
 710fields_from_line([F|FT], [V|VT]) -->
 711    to_nul_s(Codes),
 712    { field_to_prolog(F, Codes, V) },
 713    fields_from_line(FT, VT).
 714
 715to_nul_s([]) --> [0], !.
 716to_nul_s([H|T]) --> [H], to_nul_s(T).
 717
 718field_to_prolog(ref_names, Line, List) :-
 719    phrase(ref_names(List), Line),
 720    !.
 721field_to_prolog(_, Line, Atom) :-
 722    atom_codes(Atom, Line).
 723
 724ref_names([]) --> [].
 725ref_names(List) -->
 726    blanks, "(", ref_name_list(List), ")".
 727
 728ref_name_list([H|T]) -->
 729    string_without(",)", Codes),
 730    { atom_codes(H, Codes) },
 731    (   ",", blanks
 732    ->  ref_name_list(T)
 733    ;   {T=[]}
 734    ).
 735
 736
 737%!  git_show(+Dir, +Hash, -Commit, +Options) is det.
 738%
 739%   Fetch info from a GIT commit.  Options processed:
 740%
 741%     * diff(Diff)
 742%     GIT option on how to format diffs.  E.g. =stat=
 743%     * max_lines(Count)
 744%     Truncate the body at Count lines.
 745%
 746%   @param  Commit is a term git_commit(...)-Body.  Body is currently
 747%           a list of lines, each line represented as a list of
 748%           codes.
 749
 750:- record
 751    git_commit(tree_hash:atom,
 752               parent_hashes:list,
 753               author_name:atom,
 754               author_date:atom,
 755               committer_name:atom,
 756               committer_date:atom,
 757               subject:atom).
 758
 759git_show(Dir, Hash, Commit, Options) :-
 760    git_format_string(git_commit, Fields, Format),
 761    option(diff(Diff), Options, patch),
 762    diff_arg(Diff, DiffArg),
 763    git_process_output([ show, DiffArg, Hash, Format ],
 764                       read_commit(Fields, Commit, Options),
 765                       [directory(Dir)]).
 766
 767diff_arg(patch, '-p').
 768diff_arg(stat, '--stat').
 769
 770read_commit(Fields, Data-Body, Options, In) :-
 771    read_line_to_codes(In, Line1),
 772    record_from_line(git_commit, Fields, Line1, Data),
 773    read_line_to_codes(In, Line2),
 774    (   Line2 == []
 775    ->  option(max_lines(Max), Options, -1),
 776        read_n_lines(In, Max, Body)
 777    ;   Line2 == end_of_file
 778    ->  Body = []
 779    ).
 780
 781read_n_lines(In, Max, Lines) :-
 782    read_line_to_codes(In, Line1),
 783    read_n_lines(Line1, Max, In, Lines).
 784
 785read_n_lines(end_of_file, _, _, []) :- !.
 786read_n_lines(_, 0, In, []) :-
 787    !,
 788    setup_call_cleanup(open_null_stream(Out),
 789                       copy_stream_data(In, Out),
 790                       close(Out)).
 791read_n_lines(Line, Max0, In, [Line|More]) :-
 792    read_line_to_codes(In, Line2),
 793    Max is Max0-1,
 794    read_n_lines(Line2, Max, In, More).
 795
 796
 797%!  git_format_string(:Record, -FieldNames, -Format)
 798%
 799%   If Record is a record with  fields   whose  names  match the GIT
 800%   format field-names, Format is a  git =|--format=|= argument with
 801%   the appropriate format-specifiers,  terminated   by  %x00, which
 802%   causes the actual field to be 0-terminated.
 803
 804:- meta_predicate
 805    git_format_string(:, -, -).
 806
 807git_format_string(M:RecordName, Fields, Format) :-
 808    current_record(RecordName, M:Term),
 809    findall(F, record_field(Term, F), Fields),
 810    maplist(git_field_format, Fields, Formats),
 811    atomic_list_concat(['--format='|Formats], Format).
 812
 813record_field(Term, Name) :-
 814    arg(_, Term, Field),
 815    field_name(Field, Name).
 816
 817field_name(Name:_Type=_Default, Name) :- !.
 818field_name(Name:_Type, Name) :- !.
 819field_name(Name=_Default, Name) :- !.
 820field_name(Name, Name).
 821
 822git_field_format(Field, Fmt) :-
 823    (   git_format(NoPercent, Field)
 824    ->  atomic_list_concat(['%', NoPercent, '%x00'], Fmt)
 825    ;   existence_error(git_format, Field)
 826    ).
 827
 828git_format('H', commit_hash).
 829git_format('h', abbreviated_commit_hash).
 830git_format('T', tree_hash).
 831git_format('t', abbreviated_tree_hash).
 832git_format('P', parent_hashes).
 833git_format('p', abbreviated_parent_hashes).
 834
 835git_format('an', author_name).
 836git_format('aN', author_name_mailcap).
 837git_format('ae', author_email).
 838git_format('aE', author_email_mailcap).
 839git_format('ad', author_date).
 840git_format('aD', author_date_rfc2822).
 841git_format('ar', author_date_relative).
 842git_format('at', author_date_unix).
 843git_format('ai', author_date_iso8601).
 844
 845git_format('cn', committer_name).
 846git_format('cN', committer_name_mailcap).
 847git_format('ce', committer_email).
 848git_format('cE', committer_email_mailcap).
 849git_format('cd', committer_date).
 850git_format('cD', committer_date_rfc2822).
 851git_format('cr', committer_date_relative).
 852git_format('ct', committer_date_unix).
 853git_format('ci', committer_date_iso8601).
 854
 855git_format('d', ref_names).             % git log?
 856git_format('e', encoding).              % git log?
 857
 858git_format('s', subject).
 859git_format('f', subject_sanitized).
 860git_format('b', body).
 861git_format('N', notes).
 862
 863git_format('gD', reflog_selector).
 864git_format('gd', shortened_reflog_selector).
 865git_format('gs', reflog_subject).
 866
 867
 868                 /*******************************
 869                 *            MESSAGES          *
 870                 *******************************/
 871
 872:- multifile
 873    prolog:message//1.
 874
 875prolog:message(git(output(Codes))) -->
 876    { split_lines(Codes, Lines) },
 877    git_lines(Lines).
 878
 879git_lines([]) --> [].
 880git_lines([H|T]) -->
 881    [ '~s'-[H] ],
 882    (   {T==[]}
 883    ->  []
 884    ;   [nl], git_lines(T)
 885    ).
 886
 887split_lines([], []) :- !.
 888split_lines(All, [Line1|More]) :-
 889    append(Line1, [0'\n|Rest], All),
 890    !,
 891    split_lines(Rest, More).
 892split_lines(Line, [Line]).