From 9d011d1bb8aa870228a9a618d65a2cea3ff5e8e4 Mon Sep 17 00:00:00 2001
From: Christopher Baines <mail@cbaines.net>
Date: Sat, 21 Oct 2023 17:14:42 +0100
Subject: Support filtering by branch

---
 guix-qa-frontpage/server.scm       | 36 ++++++++++++++++++++++++++++++------
 guix-qa-frontpage/view/patches.scm | 19 ++++++++++++++++++-
 2 files changed, 48 insertions(+), 7 deletions(-)

diff --git a/guix-qa-frontpage/server.scm b/guix-qa-frontpage/server.scm
index 4e88a3b..5c7023e 100644
--- a/guix-qa-frontpage/server.scm
+++ b/guix-qa-frontpage/server.scm
@@ -232,9 +232,27 @@
                          symbol-key
                          #f))))
                 query-params))
+              (latest-series-branches
+               (map
+                (match-lambda
+                  ((_ . series)
+                   (patchwork-series->branch series)))
+                latest-series))
+              (branch-options
+               (sort (delete-duplicates
+                      latest-series-branches)
+                     string<?))
+              (filtered-branches
+               (filter-map
+                (match-lambda
+                  ((key . val)
+                   (if (string=? key "branch")
+                       val
+                       #f)))
+                query-params))
               (latest-series-with-overall-statuses
                (filter-map
-                (lambda (series)
+                (lambda (series branch)
                   (let ((overall-status
                          (with-sqlite-cache
                           database
@@ -243,13 +261,17 @@
                           #:store-computed-value? #f
                           #:args (list (first series))
                           #:ttl 3600)))
-                    (if (or (null? filtered-statuses)
-                            (member overall-status
-                                    filtered-statuses))
+                    (if (and (or (null? filtered-statuses)
+                                 (member overall-status
+                                         filtered-statuses))
+                             (or (null? filtered-branches)
+                                 (member branch filtered-branches)))
                         (append series
-                                `((overall-status . ,overall-status)))
+                                `((branch . ,branch)
+                                  (overall-status . ,overall-status)))
                         #f)))
-                latest-series))
+                latest-series
+                latest-series-branches))
               (sorted-latest-series
                (sort
                 latest-series-with-overall-statuses
@@ -298,6 +320,8 @@
           #:sxml
           (patches-view sorted-latest-series
                         filtered-statuses
+                        branch-options
+                        filtered-branches
                         systems-with-low-substitute-availability))))
       (('GET "issue" (? (lambda (s) (string-suffix? ".svg" s)) number.svg))
        (let* ((number
diff --git a/guix-qa-frontpage/view/patches.scm b/guix-qa-frontpage/view/patches.scm
index bdace25..f79e4a7 100644
--- a/guix-qa-frontpage/view/patches.scm
+++ b/guix-qa-frontpage/view/patches.scm
@@ -2,12 +2,15 @@
   #:use-module (srfi srfi-1)
   #:use-module (ice-9 match)
   #:use-module (ice-9 string-fun)
+  #:use-module (guix-qa-frontpage manage-patch-branches)
   #:use-module (guix-qa-frontpage issue)
   #:use-module (guix-qa-frontpage view util)
   #:export (patches-view))
 
 (define (patches-view latest-series
                       filtered-statuses
+                      branch-options
+                      filtered-branches
                       systems-with-low-substitute-availability)
 
   (define (status->issue-status-span status)
@@ -73,10 +76,11 @@ will appear first.")
              '((@ (open ""))))
        (summary "Filter issues")
        (form
+        (@ (style "text-align: left;"))
+        (label "By status")
         ,@(map
            (lambda (status)
              `(div
-               (@ (style "text-align: left;"))
                (input (@ (type "checkbox")
                          (id ,status)
                          (name ,status)
@@ -91,6 +95,19 @@ will appear first.")
                         "-"
                         " "))))
            %overall-statuses)
+        (label (@ (for "branch-filter"))
+               "By branch")
+        (select (@ (name "branch")
+                   (id "branch-filter")
+                   (multiple "true"))
+                ,@(map
+                   (lambda (branch)
+                     `(option (@ (value ,branch)
+                                 ,@(if (member branch filtered-branches)
+                                       '((selected ""))
+                                       '()))
+                              ,branch))
+                   branch-options))
         (button (@ (type "submit")) "Update")))
       (table
        (tbody
-- 
cgit v1.2.3