diff options
| -rw-r--r-- | guix-qa-frontpage/branch.scm | 5 | ||||
| -rw-r--r-- | guix-qa-frontpage/git-repository.scm | 23 |
2 files changed, 25 insertions, 3 deletions
diff --git a/guix-qa-frontpage/branch.scm b/guix-qa-frontpage/branch.scm index 5a51a59..9ffc797 100644 --- a/guix-qa-frontpage/branch.scm +++ b/guix-qa-frontpage/branch.scm @@ -104,10 +104,11 @@ "master") (string-prefix? "version-" (assoc-ref branch "name")) + (string-prefix? "wip-" + (assoc-ref branch "name")) (string=? (assoc-ref branch "commit") ""))) - (list-branches - (list-branches-url %data-service-guix-repository-id)))))) + (get-git-remote-branches "origin"))))) (let* ((initial-ordered-branches (stable-sort branches diff --git a/guix-qa-frontpage/git-repository.scm b/guix-qa-frontpage/git-repository.scm index 2140c1e..6ff3eb2 100644 --- a/guix-qa-frontpage/git-repository.scm +++ b/guix-qa-frontpage/git-repository.scm @@ -23,7 +23,8 @@ get-commit get-git-branch-head-committer-date - get-git-merge-base)) + get-git-merge-base + get-git-remote-branches)) (define %git-repository-location (make-parameter #f)) @@ -135,3 +136,23 @@ (first lines))) (loop (read-line pipe) (cons line lines)))))))) + +(define (get-git-remote-branches remote) + (with-bare-git-repository + (lambda () + (let ((pipe (open-pipe* OPEN_READ + "git" "ls-remote" "--heads" remote))) + (let loop ((line (read-line pipe)) + (result '())) + (if (eof-object? line) + (begin + (close-pipe pipe) + + result) + (let ((commit (string-take line 40)) + (branch (string-drop line 52))) + (loop (read-line pipe) + (cons + `(("name" . ,branch) + ("commit" . ,commit)) + result))))))))) |