1:- module(git, [git_clone/3, clone_project/3, git_commits/2, git_commits/3,
    2                git_branches/2, git_branch/2, git_remote/3, git_pull/1, git_pull/3]).    3
    4:- use_module(utility).    5
    6clone_project(Url, Commit, Path) :-
    7    file_base_name(Url, TempPath),
    8    string_concat_list([TempPath, "-", Commit], Path),
    9
   10    process(path(git), ["clone", Url, Path]),
   11    process(path(git), ["checkout", Commit], [path(Path)]).
   12
   13git_clone(Url, Path, Commit) :-
   14    var(Commit),
   15    file_base_name(Url, Path),
   16
   17    process(path(git), ['clone', Url, Path]),
   18    git_checkout(Path, Commit).
   19git_clone(Url, Path, Commit) :-
   20    nonvar(Commit),
   21    file_base_name(Url, TempPath),
   22    atomic_list_concat([TempPath, '-', Commit], Path),
   23
   24    process(path(git), ['clone', Url, Path]),
   25    git_checkout(Path, Commit).
   26
   27% Either shows the current commit if commit is no provided, or does git checkout COMMIT in the specified path
   28git_checkout(Path, Commit) :-
   29    var(Commit),
   30    process(path(git), ['rev-parse', 'HEAD'], [path(Path), output(Temp)]),
   31    atom_concat(Commit, '\n', Temp).
   32git_checkout(Path, Commit) :-
   33    nonvar(Commit),
   34    process(path(git), ['checkout', Commit], [path(Path)]).
   35
   36git_commits(Path, Commits) :-
   37    process(path(git), ['--no-pager', 'log', '--format=%H'], [path(Path), lines(AllCommits)]),
   38    include(\=(''), AllCommits, Commits).
   39
   40git_commits(Path, Subpath, Commits) :-
   41    process(path(git), ['--no-pager', 'log', '--format=%H', '--', Subpath], [path(Path), lines(AllCommits)]),
   42    include(\=(''), AllCommits, Commits).
   43
   44% Gets the remote for some branch
   45git_remote(RepoPath, Branch, Remote) :-
   46    var(Branch),
   47    git_branch(RepoPath, Branch),
   48    git_remote(RepoPath, Branch, Remote).
   49git_remote(RepoPath, Branch, Remote) :-
   50    nonvar(Branch),
   51    atomic_list_concat(['branch', Branch, 'remote'], '.', Option),
   52    process(path(git), ['config', '--local', Option], [path(RepoPath), lines([Remote|_])]).
   53
   54% Lists all branches from all remotes
   55git_branches(RepoPath, Branches) :-
   56    process(path(git), ['branch', '-r', '--no-color', '--no-abbrev'], [path(RepoPath), lines(Lines)]),
   57
   58    findall(branch(Remote, BranchName),
   59    (
   60        member(Line, Lines),
   61        trim(Line, Trimmed),
   62        atomic_list_concat([Remote, BranchName], '/', Trimmed)
   63    ), Branches).
   64
   65% Shows the current branch
   66git_branch(RepoPath, Branch) :-
   67    process(path(git), ['branch', '--no-color', '--no-abbrev'], [path(RepoPath), lines(Lines)]),
   68    member(Line, Lines),
   69    atom_concat('* ', Branch, Line).
   70
   71% Perform a pull (default remote onto default branch)
   72git_pull(RepoPath) :- git_pull(RepoPath, _, _).
   73git_pull(RepoPath, Remote, Branch) :-
   74    var(Remote),
   75    git_remote(RepoPath, Branch, Remote),
   76    git_pull(RepoPath, Branch, Remote).
   77git_pull(RepoPath, Remote, Branch) :-
   78    nonvar(Remote),
   79    var(Branch),
   80    git_branch(RepoPath, Branch),
   81    git_pull(RepoPath, Remote, Branch).
   82git_pull(RepoPath, Remote, Branch) :-
   83    nonvar(Remote),
   84    nonvar(Branch),
   85    process(path(git), ['pull', Remote, Branch], [path(RepoPath), output(_)])