Add some more issue statuses

So it's easier to find issues that have specific problems.

4 files changed, 72 insertions, 13 deletions

diff --git a/guix-qa-frontpage/issue.scm b/guix-qa-frontpage/issue.scm
index 1f20e22..345aafe 100644
--- a/guix-qa-frontpage/issue.scm
+++ b/guix-qa-frontpage/issue.scm
@@ -45,12 +45,16 @@
 (define bad-status 'important-checks-failing)
 (define needs-looking-at-status 'needs-looking-at)
 (define unknown-status 'unknown)
+(define failed-to-apply-patches-status 'failed-to-apply-patches)
+(define guix-data-service-failed-status 'guix-data-service-failed)
 
 (define %overall-statuses
   (list reviewed-looks-good-status
         good-status
         unknown-status
         needs-looking-at-status
+        failed-to-apply-patches-status
+        guix-data-service-failed-status
         bad-status))
 
 (define (status-index status)
@@ -62,8 +66,10 @@
   (list-ref %overall-statuses
             (apply max (map status-index statuses))))
 
-(define (issue-patches-overall-status derivation-changes-counts
+(define (issue-patches-overall-status patches-failed-to-apply?
                                       builds-missing?
+                                      derivation-changes
+                                      comparison-details
                                       mumi-tags
                                       debbugs-usertags)
   (define %systems-to-consider
@@ -72,7 +78,23 @@
       "aarch64-linux"
       "armhf-linux"))
 
-  (define builds-status
+  (define (guix-data-service-failed?)
+    (and=>
+     (assq-ref comparison-details 'exception)
+     (lambda (exception)
+       (and=>
+        (assq-ref comparison-details 'invalid_query_parameters)
+        (lambda (invalid-params)
+          (and=>
+           (assoc-ref invalid-params "target_commit")
+           (lambda (target-commit)
+             (eq? (assq-ref target-commit 'error)
+                  'failed-to-process-revision))))))))
+
+  (define (builds-status)
+    (define derivation-changes-counts
+      (assq-ref derivation-changes 'counts))
+
     (if builds-missing?
         unknown-status
         (if (null? derivation-changes-counts)
@@ -121,8 +143,12 @@
   ;; information
   (if (eq? tags-status reviewed-looks-good-status)
       reviewed-looks-good-status
-      (worst-status (list builds-status
-                          tags-status))))
+      (cond
+       (patches-failed-to-apply? failed-to-apply-patches-status)
+       ((guix-data-service-failed?) guix-data-service-failed-status)
+       (else
+        (worst-status (list (builds-status)
+                            tags-status))))))
 
 (define (issue-data number)
   (let* ((base-and-target-refs
@@ -290,12 +316,21 @@
                  database
                  'issue-patches-overall-status
                  (lambda _
-                   (issue-patches-overall-status
-                    (assq-ref derivation-changes 'counts)
-                    builds-missing?
-                    (assq-ref (assq-ref series-data 'mumi)
-                              'tags)
-                    (assq-ref series-data 'usertags)))
+                   (let ((patches-failed-to-apply?
+                          (and
+                           (not base-and-target-refs)
+                           (not (eq? (select-create-branch-for-issue-log
+                                      database
+                                      issue-number)
+                                     #f)))))
+                     (issue-patches-overall-status
+                      patches-failed-to-apply?
+                      builds-missing?
+                      derivation-changes
+                      comparison-details
+                      (assq-ref (assq-ref series-data 'mumi)
+                                'tags)
+                      (assq-ref series-data 'usertags))))
                  #:args (list issue-number)
                  #:ttl 0)))
             #:unwind? #t)))
diff --git a/guix-qa-frontpage/server.scm b/guix-qa-frontpage/server.scm
index 1151d6f..9c5564d 100644
--- a/guix-qa-frontpage/server.scm
+++ b/guix-qa-frontpage/server.scm
@@ -240,9 +240,7 @@
                                                'unknown)))
                     (if (eq? a-overall-status
                              b-overall-status)
-                        (if (member a-overall-status
-                                    '(important-checks-passing
-                                      reviewed-looks-good))
+                        (if (not (eq? a-overall-status 'unknown))
                             (< (first a)
                                (first b))
                             (> (first a)
diff --git a/guix-qa-frontpage/view/patches.scm b/guix-qa-frontpage/view/patches.scm
index 65c693a..3d90d3f 100644
--- a/guix-qa-frontpage/view/patches.scm
+++ b/guix-qa-frontpage/view/patches.scm
@@ -50,6 +50,14 @@ will appear first.")
                            `((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"))
diff --git a/guix-qa-frontpage/view/util.scm b/guix-qa-frontpage/view/util.scm
index 46875aa..03697c8 100644
--- a/guix-qa-frontpage/view/util.scm
+++ b/guix-qa-frontpage/view/util.scm
@@ -163,6 +163,15 @@ main > header {
   display: inline-block;
 }
 
+.yellow-dot {
+  vertical-align: text-bottom;
+  height: 23px;
+  width: 23px;
+  background-color: yellow;
+  border-radius: 50%;
+  display: inline-block;
+}
+
 .red-dot {
   vertical-align: text-bottom;
   height: 23px;
@@ -172,6 +181,15 @@ main > header {
   display: inline-block;
 }
 
+.darkred-dot {
+  vertical-align: text-bottom;
+  height: 23px;
+  width: 23px;
+  background-color: darkred;
+  border-radius: 50%;
+  display: inline-block;
+}
+
 .grey-dot {
   vertical-align: text-bottom;
   height: 23px;