diff options
| author | Christopher Baines <mail@cbaines.net> | 2023-05-24 17:15:11 +0100 |
|---|---|---|
| committer | Christopher Baines <mail@cbaines.net> | 2023-05-24 17:15:11 +0100 |
| commit | 5b5281e4a02c6d3e9070a1379b902216a77f7b82 (patch) | |
| tree | 785a6e6c3f167a32ea67418b7ec772605895b5e0 | |
| parent | bf97d9f7615df9f736f27ae06e271a7d4113c33b (diff) | |
| download | qa-frontpage-5b5281e4a02c6d3e9070a1379b902216a77f7b82.tar qa-frontpage-5b5281e4a02c6d3e9070a1379b902216a77f7b82.tar.gz | |
Show a table of branches on the homepage
| -rw-r--r-- | guix-qa-frontpage/server.scm | 10 | ||||
| -rw-r--r-- | guix-qa-frontpage/view/home.scm | 33 |
2 files changed, 33 insertions, 10 deletions
diff --git a/guix-qa-frontpage/server.scm b/guix-qa-frontpage/server.scm index d77b646..5626eb5 100644 --- a/guix-qa-frontpage/server.scm +++ b/guix-qa-frontpage/server.scm @@ -76,8 +76,14 @@ (match method-and-path-components (('GET) - (render-html - #:sxml (home))) + (let ((branches + (with-sqlite-cache + database + 'list-non-master-branches + list-non-master-branches + #:ttl 0))) + (render-html + #:sxml (home branches)))) (('GET "assets" rest ...) (or (handle-static-assets (string-join rest "/") (request-headers request)) diff --git a/guix-qa-frontpage/view/home.scm b/guix-qa-frontpage/view/home.scm index 34ef358..271bef8 100644 --- a/guix-qa-frontpage/view/home.scm +++ b/guix-qa-frontpage/view/home.scm @@ -1,8 +1,10 @@ (define-module (guix-qa-frontpage view home) + #:use-module (srfi srfi-1) + #:use-module (ice-9 match) #:use-module (guix-qa-frontpage view util) #:export (home)) -(define (home) +(define (home branches) (layout #:description "Guix Quality Assurance" #:body @@ -26,13 +28,28 @@ (h2 "Branches") (div - (@ (class "row two-element-row")) - (section - (a (@ (href "/branch/gnome-team")) - (h3 "branch: gnome-team"))) - (section - (a (@ (href "/branch/rust-team")) - (h3 "branch: rust-team")))) + (@ (class "row")) + (table + (thead + (tr (th "Branch") + (th "Request to merge"))) + (tbody + ,@(append-map + (match-lambda + ((branch . details) + (let ((issue-number + (assoc-ref details "issue_number"))) + `((tr + (td (a (@ (href ,(string-append "/branch/" branch)) + (style "font-family: monospace;")) + ,branch)) + (td ,@(if issue-number + `((a (@ (href ,(string-append + "https://issues.guix.gnu.org/" + (number->string issue-number)))) + "#" ,issue-number)) + '()))))))) + branches)))) (h2 ,(gettext "Patches" "guix-qa-frontpage")) (a (@ (href "/patches")) |