Allow filtering issues by status

3 files changed, 100 insertions, 12 deletions

diff --git a/guix-qa-frontpage/server.scm b/guix-qa-frontpage/server.scm
index 9c5564d..1514d7b 100644
--- a/guix-qa-frontpage/server.scm
+++ b/guix-qa-frontpage/server.scm
@@ -216,19 +216,38 @@
                 'latest-patchwork-series-by-issue
                 latest-patchwork-series-by-issue
                 #:ttl 1800))
+              (query-params
+               (or (and=>
+                    (uri-query (request-uri request))
+                    parse-query-string)
+                   '()))
+              (filtered-statuses
+               (filter-map
+                (match-lambda
+                  ((key . val)
+                   (let ((symbol-key (string->symbol key)))
+                     (if (and (member symbol-key %overall-statuses)
+                              (string=? val "on"))
+                         symbol-key
+                         #f))))
+                query-params))
               (latest-series-with-overall-statuses
-               (map
+               (filter-map
                 (lambda (series)
-                  (append series
-                          `((overall-status
-                             .
-                             ,(with-sqlite-cache
-                               database
-                               'issue-patches-overall-status
-                               (const #f)
-                               #:store-computed-value? #f
-                               #:args (list (first series))
-                               #:ttl 3600)))))
+                  (let ((overall-status
+                         (with-sqlite-cache
+                          database
+                          'issue-patches-overall-status
+                          (const 'unknown)
+                          #:store-computed-value? #f
+                          #:args (list (first series))
+                          #:ttl 3600)))
+                    (if (or (null? filtered-statuses)
+                            (member overall-status
+                                    filtered-statuses))
+                        (append series
+                                `((overall-status . ,overall-status)))
+                        #f)))
                 latest-series))
               (sorted-latest-series
                (sort
@@ -280,6 +299,7 @@
                                patch-issues-to-show)
                             (take sorted-latest-series patch-issues-to-show)
                             sorted-latest-series)
+                        filtered-statuses
                         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 3d90d3f..dd583f2 100644
--- a/guix-qa-frontpage/view/patches.scm
+++ b/guix-qa-frontpage/view/patches.scm
@@ -1,10 +1,46 @@
 (define-module (guix-qa-frontpage view patches)
   #:use-module (srfi srfi-1)
   #:use-module (ice-9 match)
+  #:use-module (ice-9 string-fun)
+  #:use-module (guix-qa-frontpage issue)
   #:use-module (guix-qa-frontpage view util)
   #:export (patches-view))
 
-(define (patches-view latest-series systems-with-low-substitute-availability)
+(define (patches-view latest-series
+                      filtered-statuses
+                      systems-with-low-substitute-availability)
+
+  (define (status->issue-status-span status)
+    (cond
+     ((eq? status 'reviewed-looks-good)
+      `(span (@ (aria-label "status: darkgreen")
+                (class "darkgreen-dot"))
+             (*ENTITY* "#10004")))
+     ((eq? status 'important-checks-passing)
+      '(span (@ (aria-label "status: green")
+                (class "green-dot"))
+             (*ENTITY* "#10004")))
+     ((eq? status 'important-checks-failing)
+      '(span (@ (aria-label "status: red")
+                (class "red-dot"))
+             (*ENTITY* "#10005")))
+     ((eq? status 'failed-to-apply-patches)
+      '(span (@ (aria-label "status: darkred")
+                (class "darkred-dot"))
+             (*ENTITY* "#10005")))
+     ((eq? status 'guix-data-service-failed)
+      '(span (@ (aria-label "status: yellow")
+                (class "yellow-dot"))
+             (*ENTITY* "#10005")))
+     ((eq? status 'needs-looking-at)
+      '(span (@ (aria-label "status: orange")
+                (class "orange-dot"))
+             (*ENTITY* "#9888")))
+     (else
+      `(span (@ (aria-label "status: grey")
+                (class "grey-dot"))
+             "?"))))
+
   (layout
    #:title "Patches"
    #:body
@@ -27,6 +63,31 @@ will appear first.")
                               ,system
                               " ")))
                     systems-with-low-substitute-availability))))
+      (details
+       ,@(if (null? filtered-statuses)
+             '()
+             '((@ (open ""))))
+       (summary "Filter issues")
+       (form
+        ,@(map
+           (lambda (status)
+             `(div
+               (@ (style "text-align: left;"))
+               (input (@ (type "checkbox")
+                         (id ,status)
+                         (name ,status)
+                         ,@(if (member status filtered-statuses)
+                               '((checked ""))
+                               '())))
+               (label (@ (for ,status))
+                      ,(status->issue-status-span status)
+                      " "
+                      ,(string-replace-substring
+                        (symbol->string status)
+                        "-"
+                        " "))))
+           %overall-statuses)
+        (button (@ (type "submit")) "Update")))
       (table
        (tbody
         ,@(map (match-lambda
diff --git a/guix-qa-frontpage/view/util.scm b/guix-qa-frontpage/view/util.scm
index 03697c8..8cac983 100644
--- a/guix-qa-frontpage/view/util.scm
+++ b/guix-qa-frontpage/view/util.scm
@@ -143,6 +143,7 @@ main > header {
   background-color: #006400;
   border-radius: 50%;
   display: inline-block;
+  text-align: center;
 }
 
 .green-dot {
@@ -152,6 +153,7 @@ main > header {
   background-color: #28a745;
   border-radius: 50%;
   display: inline-block;
+  text-align: center;
 }
 
 .orange-dot {
@@ -161,6 +163,7 @@ main > header {
   background-color: orange;
   border-radius: 50%;
   display: inline-block;
+  text-align: center;
 }
 
 .yellow-dot {
@@ -170,6 +173,7 @@ main > header {
   background-color: yellow;
   border-radius: 50%;
   display: inline-block;
+  text-align: center;
 }
 
 .red-dot {
@@ -179,6 +183,7 @@ main > header {
   background-color: red;
   border-radius: 50%;
   display: inline-block;
+  text-align: center;
 }
 
 .darkred-dot {
@@ -188,6 +193,7 @@ main > header {
   background-color: darkred;
   border-radius: 50%;
   display: inline-block;
+  text-align: center;
 }
 
 .grey-dot {
@@ -197,6 +203,7 @@ main > header {
   background-color: grey;
   border-radius: 50%;
   display: inline-block;
+  text-align: center;
 }
 
 ")