From 46810915c31dbf75d6ab2c6e4804b5c466ffc8df Mon Sep 17 00:00:00 2001
From: Christopher Baines <mail@cbaines.net>
Date: Mon, 22 May 2023 19:37:02 +0100
Subject: Add get-git-merge-base helper

---
 guix-qa-frontpage/git-repository.scm | 20 +++++++++++++++++++-
 1 file changed, 19 insertions(+), 1 deletion(-)

(limited to 'guix-qa-frontpage/git-repository.scm')

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))))))))
-- 
cgit v1.2.3