diff options
| author | Christopher Baines <mail@cbaines.net> | 2025-01-06 12:24:58 +0000 |
|---|---|---|
| committer | Christopher Baines <mail@cbaines.net> | 2025-01-06 12:24:58 +0000 |
| commit | 33244c18ac0c080345baab491a46868187ca34e2 (patch) | |
| tree | 9af3bb80d73f810f9786c0a739dbb417e2fdba48 | |
| parent | dadfd92bc9155c13137f2738013e03a80c3aa3f6 (diff) | |
| download | qa-frontpage-33244c18ac0c080345baab491a46868187ca34e2.tar qa-frontpage-33244c18ac0c080345baab491a46868187ca34e2.tar.gz | |
Improve the branches page
And add a JSON repsonse.
| -rw-r--r-- | guix-qa-frontpage/server.scm | 26 | ||||
| -rw-r--r-- | guix-qa-frontpage/view/branches.scm | 22 | ||||
| -rw-r--r-- | guix-qa-frontpage/view/util.scm | 4 |
3 files changed, 39 insertions, 13 deletions
diff --git a/guix-qa-frontpage/server.scm b/guix-qa-frontpage/server.scm index 8ec745f..fa89251 100644 --- a/guix-qa-frontpage/server.scm +++ b/guix-qa-frontpage/server.scm @@ -163,14 +163,24 @@ (let ((branches (with-sqlite-cache database - 'branches - (lambda () - (list-branches - (list-branches-url %data-service-guix-repository-id))) - #:ttl 60))) - (render-html - #:sxml - (branches-view branches)))) + 'list-non-master-branches + list-non-master-branches + #:ttl 300))) + (case (most-appropriate-mime-type + '(application/json text/html) + mime-types) + ((application/json) + (render-json + `((branches . ,(list->vector + (map (match-lambda + ((name . details) + `((name . ,name) + ,@details))) + branches)))))) + (else + (render-html + #:sxml + (branches-view branches)))))) (('GET "branch" "master") (let ((substitute-availability systems-with-low-substitute-availability diff --git a/guix-qa-frontpage/view/branches.scm b/guix-qa-frontpage/view/branches.scm index 90d1da7..9573d2b 100644 --- a/guix-qa-frontpage/view/branches.scm +++ b/guix-qa-frontpage/view/branches.scm @@ -10,10 +10,22 @@ #:body `((main (table + (thead + (tr (th "Branch") + (th "Request to merge"))) (tbody - ,@(map (lambda (branch-details) - (let ((name (assoc-ref branch-details "name"))) - `(tr - (td (a (@ (href ,(simple-format #f "/branch/~A" name))) - ,name))))) + ,@(map (match-lambda + ((name . details) + (let ((issue-number + (assoc-ref details "issue_number"))) + `(tr + (td (a (@ (href ,(simple-format #f "/branch/~A" name)) + (style "font-family: monospace;")) + ,name)) + (td ,@(if issue-number + `((a (@ (href ,(string-append + "https://issues.guix.gnu.org/" + (number->string issue-number)))) + "#" ,issue-number)) + '())))))) branches))))))) diff --git a/guix-qa-frontpage/view/util.scm b/guix-qa-frontpage/view/util.scm index 60ec66a..1b0d945 100644 --- a/guix-qa-frontpage/view/util.scm +++ b/guix-qa-frontpage/view/util.scm @@ -45,6 +45,7 @@ table/branches-with-most-recent-commits render-html + render-json general-not-found error-page @@ -417,6 +418,9 @@ main > header { (define render-html guix-data-service:render-html) +(define render-json + guix-data-service:render-json) + (define (general-not-found header-text body) (layout #:body |