From 4590e4822dda792f59f69b764824aa148d92dad0 Mon Sep 17 00:00:00 2001
From: Arun Isaac <arunisaac@systemreboot.net>
Date: Mon, 17 Oct 2022 01:03:26 +0530
Subject: 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.
---
 mumi/config.scm.in     |  4 +++-
 mumi/web/view/html.scm | 17 +++++++++++++++++
 2 files changed, 20 insertions(+), 1 deletion(-)

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")
-- 
cgit v1.2.3