diff mbox series

[bug#58573] Add QA status badge to issue page.

Message ID 20221016193326.14634-1-arunisaac@systemreboot.net
State Accepted
Headers show
Series [bug#58573] Add QA status badge to issue page. | expand

Checks

Context Check Description
cbaines/applying patch fail View Laminar job
cbaines/issue success View issue

Commit Message

Arun Isaac Oct. 16, 2022, 7:33 p.m. UTC 
* 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.
---
 mumi/config.scm.in     |  4 +++-
 mumi/web/view/html.scm | 17 +++++++++++++++++
 2 files changed, 20 insertions(+), 1 deletion(-)

Comments

Ricardo Wurmus Oct. 16, 2022, 8:05 p.m. UTC | #1 
Arun Isaac <arunisaac@systemreboot.net> writes:

> * 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.

Applied, thank you!
diff mbox series

Patch

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")