diff options
| author | Christopher Baines <mail@cbaines.net> | 2023-05-22 19:37:02 +0100 |
|---|---|---|
| committer | Christopher Baines <mail@cbaines.net> | 2023-05-22 19:37:02 +0100 |
| commit | 46810915c31dbf75d6ab2c6e4804b5c466ffc8df (patch) | |
| tree | 68a7d8f8ebe1383c58de7f9f2b6fd5530a54810d /guix-qa-frontpage/git-repository.scm | |
| parent | e8ae78a8e961084752192382a06f39a6af1a13d0 (diff) | |
| download | qa-frontpage-46810915c31dbf75d6ab2c6e4804b5c466ffc8df.tar qa-frontpage-46810915c31dbf75d6ab2c6e4804b5c466ffc8df.tar.gz | |
Add get-git-merge-base helper
Diffstat (limited to 'guix-qa-frontpage/git-repository.scm')
| -rw-r--r-- | guix-qa-frontpage/git-repository.scm | 20 |
1 files changed, 19 insertions, 1 deletions
diff --git a/guix-qa-frontpage/git-repository.scm b/guix-qa-frontpage/git-repository.scm index 9b733f7..17c0ef5 100644 --- a/guix-qa-frontpage/git-repository.scm +++ b/guix-qa-frontpage/git-repository.scm @@ -21,7 +21,8 @@ get-commit - get-git-branch-head-committer-date)) + get-git-branch-head-committer-date + get-git-merge-base)) (define %git-repository-location (make-parameter #f)) @@ -108,3 +109,20 @@ "~Y-~m-~d ~H:~M:~S ~z"))) (loop (read-line pipe) (cons line lines)))))))) + +(define (get-git-merge-base a b) + (with-bare-git-repository + (lambda () + (let ((pipe (open-pipe* OPEN_READ + "git" "merge-base" a b))) + (let loop ((line (read-line pipe)) + (lines '())) + (if (eof-object? line) + (begin + (close-pipe pipe) + + (if (null? lines) + #f + (first lines))) + (loop (read-line pipe) + (cons line lines)))))))) |