diff options
| author | Christopher Baines <mail@cbaines.net> | 2025-01-09 10:13:03 +0000 |
|---|---|---|
| committer | Christopher Baines <mail@cbaines.net> | 2025-01-09 10:13:03 +0000 |
| commit | 3fbf9676840a8634a2ae00668e8335e952b5867e (patch) | |
| tree | 215b385395e2fa8788d27d3bcef64ea3c508fbad | |
| parent | 33244c18ac0c080345baab491a46868187ca34e2 (diff) | |
| download | qa-frontpage-3fbf9676840a8634a2ae00668e8335e952b5867e.tar qa-frontpage-3fbf9676840a8634a2ae00668e8335e952b5867e.tar.gz | |
Use the git repository for listing branches
As the QA data service is now fetching data from QA (maybe this should
be changed in the future), this avoids a circular dependency.
| -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))))))))) |