diff options
| author | Arun Isaac <arunisaac@systemreboot.net> | 2022-10-17 01:03:26 +0530 |
|---|---|---|
| committer | Ricardo Wurmus <rekado@elephly.net> | 2022-10-16 22:05:28 +0200 |
| commit | 4590e4822dda792f59f69b764824aa148d92dad0 (patch) | |
| tree | ded1ab7c59eac30b45b0c507183f5f7ce847b362 | |
| parent | 5455c239217594eae6f83443fc58d71e5c2975e6 (diff) | |
Add QA status badge to issue page.
* mumi/config.scm.in (%config): Add qa-scheme and qa-host
configuration parameters.
* mumi/web/view/html.scm: Import (web uri).
(build-uri-path): New function.
(issue-page): Add QA status badge.
| -rw-r--r-- | mumi/config.scm.in | 4 | ||||
| -rw-r--r-- | mumi/web/view/html.scm | 17 |
2 files changed, 20 insertions, 1 deletions
diff --git a/mumi/config.scm.in b/mumi/config.scm.in index 66ad924..ed9330a 100644 --- a/mumi/config.scm.in +++ b/mumi/config.scm.in @@ -78,6 +78,8 @@ (submission-bug-email-address . "bug-guix@gnu.org") (lists . ("guix-patches@gnu.org" "bug-guix@gnu.org")) (packages . ("guix-patches" "guix")) - (debbugs-domain . "debbugs.gnu.org")))) + (debbugs-domain . "debbugs.gnu.org") + (qa-scheme . https) + (qa-host . "qa.guix.gnu.org")))) (lambda (key) (assoc-ref config key)))) diff --git a/mumi/web/view/html.scm b/mumi/web/view/html.scm index 171fbf9..7fd85bc 100644 --- a/mumi/web/view/html.scm +++ b/mumi/web/view/html.scm @@ -26,6 +26,7 @@ #:use-module (ice-9 match) #:use-module (srfi srfi-1) #:use-module (srfi srfi-19) + #:use-module (web uri) #:export (index help unknown @@ -355,6 +356,10 @@ failed to process associated messages.") ,message (p (a (@ (href "/")) "Try something else?")))))) +(define (build-uri-path . parts) + "Encode PARTS and join them together into an absolute URI path." + (string-append "/" (encode-and-join-uri-path parts))) + (define* (issue-page bug #:optional flash-message) "Render the conversation for the given BUG." (define id (bug-num bug)) @@ -403,6 +408,18 @@ failed to process associated messages.") ;; non-ASCII characters. (sender-name (first messages)) ".") + (div + (a (@ (href ,(uri->string + (build-uri (%config 'qa-scheme) + #:host (%config 'qa-host) + #:path (build-uri-path "issue" + (number->string id)))))) + (img (@ (src ,(uri->string + (build-uri (%config 'qa-scheme) + #:host (%config 'qa-host) + #:path (build-uri-path "issue" + (number->string id) + "status-badge-medium.svg")))))))) (details (@ (class "info")) (summary "Details") |