Show the guix usertags on the issue page

5 files changed, 63 insertions, 3 deletions

diff --git a/Makefile.am b/Makefile.am
index 79b7032..b0cc621 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -36,6 +36,7 @@ SOURCES =									\
   guix-qa-frontpage/branch.scm							\
   guix-qa-frontpage/issue.scm							\
   guix-qa-frontpage/mumi.scm							\
+  guix-qa-frontpage/debbugs.scm						\
   guix-qa-frontpage/derivation-changes.scm					\
   guix-qa-frontpage/manage-builds.scm						\
   guix-qa-frontpage/manage-patch-branches.scm					\
diff --git a/guix-dev.scm b/guix-dev.scm
index a8d574e..e820570 100644
--- a/guix-dev.scm
+++ b/guix-dev.scm
@@ -54,6 +54,7 @@
          guile-fibers-1.1
          guile-kolam
          guile-git
+         guile-debbugs
          guile-readline
          guile-prometheus
          guix-build-coordinator
diff --git a/guix-qa-frontpage/debbugs.scm b/guix-qa-frontpage/debbugs.scm
new file mode 100644
index 0000000..ea37e13
--- /dev/null
+++ b/guix-qa-frontpage/debbugs.scm
@@ -0,0 +1,25 @@
+;;; Guix QA Frontpage
+;;;
+;;; Copyright © 2023 Christopher Baines <mail@cbaines.net>
+;;;
+;;; This program is free software: you can redistribute it and/or
+;;; modify it under the terms of the GNU Affero General Public License
+;;; as published by the Free Software Foundation, either version 3 of
+;;; the License, or (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;; Affero General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU Affero General Public
+;;; License along with this program.  If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+(define-module (guix-qa-frontpage debbugs)
+  #:use-module (debbugs)
+  #:export (debbugs-get-issues-with-guix-usertag))
+
+(define (debbugs-get-issues-with-guix-usertag)
+  (soap-invoke (%gnu) get-usertag "guix"))
+
diff --git a/guix-qa-frontpage/patchwork.scm b/guix-qa-frontpage/patchwork.scm
index d69ea28..335d4d1 100644
--- a/guix-qa-frontpage/patchwork.scm
+++ b/guix-qa-frontpage/patchwork.scm
@@ -2,6 +2,7 @@
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-11)
   #:use-module (ice-9 regex)
+  #:use-module (ice-9 match)
   #:use-module (rnrs bytevectors)
   #:use-module (json)
   #:use-module (web uri)
@@ -10,6 +11,7 @@
   #:use-module (web response)
   #:use-module (guix-build-coordinator utils)
   #:use-module (guix-qa-frontpage mumi)
+  #:use-module (guix-qa-frontpage debbugs)
   #:export (%patchwork-instance
 
             patchwork-patches
@@ -162,12 +164,34 @@
             (call-with-delay-logging mumi-bulk-issues
                                      #:args
                                      (list
-                                      (map first data)))))
+                                      (map first data))))
+           (debbugs-guix-usertag-data
+            (call-with-delay-logging debbugs-get-issues-with-guix-usertag))
+           (usertag-lookup
+            (let ((hash-table (make-hash-table)))
+              (for-each
+               (match-lambda
+                 ((tag . issues)
+                  (for-each
+                   (lambda (issue)
+                     (hash-set! hash-table
+                                issue
+                                (cons tag
+                                      (or (hash-ref hash-table issue)
+                                          '()))))
+                   (if (pair? issues)
+                       issues
+                       (list issues)))))
+               debbugs-guix-usertag-data)
+              hash-table)))
       (sort!
        (filter-map (lambda (data mumi)
                      (if (assq-ref mumi 'open?)
                          `(,@data
-                           (mumi . ,mumi))
+                           (mumi . ,mumi)
+                           (usertags . ,(or (hash-ref usertag-lookup
+                                                      (car data))
+                                            '())))
                          #f))
                    data
                    mumi-data)
diff --git a/guix-qa-frontpage/view/issue.scm b/guix-qa-frontpage/view/issue.scm
index 0edb034..5f4dd9d 100644
--- a/guix-qa-frontpage/view/issue.scm
+++ b/guix-qa-frontpage/view/issue.scm
@@ -23,6 +23,9 @@
   (define tagged-as-moreinfo?
     (member "moreinfo" mumi-tags))
 
+  (define debbugs-usertags
+    (assq-ref series 'usertags))
+
   (define derivation-changes-counts
     (assq-ref derivation-changes 'counts))
 
@@ -268,7 +271,13 @@ div.bad {
              (lambda (tag)
                `(span (@ (class "tag"))
                       ,tag))
-             (or mumi-tags '())))
+             (or mumi-tags '()))
+          ,@(map
+             (lambda (tag)
+               `(span (@ (class "tag"))
+                      "(guix) "
+                      ,tag))
+             (or debbugs-usertags '())))
 
       (ul
        ,@(map