Pre-compute the branch, and use the issue title as well

This allows changing the branch that QA applies the patches to by changing the
title of the issue.

3 files changed, 90 insertions, 79 deletions

diff --git a/guix-qa-frontpage/manage-patch-branches.scm b/guix-qa-frontpage/manage-patch-branches.scm
index c3ae256..16bfbd9 100644
--- a/guix-qa-frontpage/manage-patch-branches.scm
+++ b/guix-qa-frontpage/manage-patch-branches.scm
@@ -30,8 +30,6 @@
   #:use-module (guix-qa-frontpage guix-data-service)
   #:export (create-branch-for-issue
 
-            patchwork-series->branch
-
             start-manage-patch-branches-thread
 
             get-issue-branch-base-and-target-refs))
@@ -129,64 +127,6 @@
     (close-pipe pipe)
     result))
 
-(define (parse-patch-name name)
-  (let ((args
-         (and
-          (string-prefix? "[" name)
-          (let ((stop (string-index name #\])))
-            (substring name 1 stop))))
-        (as-bug-number
-         (lambda (arg)
-           (and (string-prefix? "bug#" arg)
-                (string->number (substring arg (string-length "bug#"))))))
-        (as-v2
-         (lambda (arg)
-           (and (string-prefix? "v" arg)
-                (string->number (substring arg 1)))))
-        (as-patch-number
-         (lambda (arg)
-           (match (string-split arg #\/)
-             (((= string->number index) (= string->number total))
-              (and index total (<= index total)
-                   (cons index total)))
-             (else #f)))))
-    (let analyze ((bug-number #f)
-                  (branch "master")
-                  (version 1)
-                  (index 1)
-                  (total 1)
-                  (arguments
-                   (if args
-                       (string-split args #\,)
-                       '())))
-      (match arguments
-        ((or ("") ())
-         `((bug-number . ,bug-number)
-           (branch . ,branch)
-           (version . ,version)
-           (index . ,index)
-           (total . ,total)))
-        (((= as-bug-number (? number? new-bug-number))
-          arguments ...)
-         (analyze new-bug-number branch version index total arguments))
-        (((= as-v2 (? number? new-version))
-          arguments ...)
-         (analyze bug-number branch new-version index total arguments))
-        (((= as-patch-number ((? number? new-index) . (? number? new-total)))
-          arguments ...)
-         (analyze bug-number branch version new-index new-total arguments))
-        ((feature-branch arguments ...)
-         (analyze bug-number feature-branch version index total arguments))))))
-
-(define (patchwork-series->branch series)
-  (match (assoc-ref series "patches")
-    (#() "master")
-    (#(first-patch rest ...)
-     (let ((details
-            (parse-patch-name
-             (assoc-ref first-patch "name"))))
-       (assq-ref details 'branch)))))
-
 (define (create-branch-for-issue database issue-number patchwork-series)
   (define branch-name
     (simple-format #f "issue-~A" issue-number))
@@ -196,7 +136,7 @@
 
   (define (get-base-commit)
     (let ((branch
-           (patchwork-series->branch patchwork-series)))
+           (assq-ref  patchwork-series 'branch)))
       (if (string=? branch "master")
           (get-latest-processed-branch-revision "master")
 
@@ -424,8 +364,9 @@
                           (assq-ref
                            (get-issue-branch-base-and-target-refs issue-number)
                            'base))
-                         (branch (patchwork-series->branch
-                                  (assq-ref all-patchwork-series issue-number))))
+                         (branch
+                          (assq-ref (assq-ref all-patchwork-series issue-number)
+                                    'branch)))
                      (with-exception-handler
                          (lambda (exn)
                            (if (and (guix-data-service-error? exn)
diff --git a/guix-qa-frontpage/patchwork.scm b/guix-qa-frontpage/patchwork.scm
index 8f9d570..b4e0f66 100644
--- a/guix-qa-frontpage/patchwork.scm
+++ b/guix-qa-frontpage/patchwork.scm
@@ -98,6 +98,75 @@
                     (assq-ref link-details 'uri)
                     (uri-scheme uri))))))))))
 
+(define (parse-patch-name name)
+  (let ((args
+         (and
+          (string-prefix? "[" name)
+          (let ((stop (string-index name #\])))
+            (substring name 1 stop))))
+        (as-bug-number
+         (lambda (arg)
+           (and (string-prefix? "bug#" arg)
+                (string->number (substring arg (string-length "bug#"))))))
+        (as-v2
+         (lambda (arg)
+           (and (string-prefix? "v" arg)
+                (string->number (substring arg 1)))))
+        (as-patch-number
+         (lambda (arg)
+           (match (string-split arg #\/)
+             (((= string->number index) (= string->number total))
+              (and index total (<= index total)
+                   (cons index total)))
+             (else #f)))))
+    (let analyze ((bug-number #f)
+                  (branch "master")
+                  (version 1)
+                  (index 1)
+                  (total 1)
+                  (arguments
+                   (if args
+                       (string-split args #\,)
+                       '())))
+      (match arguments
+        ((or ("") ())
+         `((bug-number . ,bug-number)
+           (branch . ,branch)
+           (version . ,version)
+           (index . ,index)
+           (total . ,total)))
+        (((= as-bug-number (? number? new-bug-number))
+          arguments ...)
+         (analyze new-bug-number branch version index total arguments))
+        (((= as-v2 (? number? new-version))
+          arguments ...)
+         (analyze bug-number branch new-version index total arguments))
+        (((= as-patch-number ((? number? new-index) . (? number? new-total)))
+          arguments ...)
+         (analyze bug-number branch version new-index new-total arguments))
+        ((feature-branch arguments ...)
+         (analyze bug-number feature-branch version index total arguments))))))
+
+(define parse-issue-title
+  (let ((regex (make-regexp "\\[([A-Z\\_a-z0-9\\-]+)\\].*")))
+    (lambda (title)
+      (match (regexp-exec regex title)
+        (#f #f)
+        (m
+         (let ((branch (match:substring m 1)))
+           (if (string=? branch "PATCH")
+               #f
+               branch)))))))
+
+(define (patchwork-series->branch series)
+  (match (assoc-ref series "patches")
+    (#() "master")
+    (#(first-patch rest ...)
+     (let ((details
+            (parse-patch-name
+             (assoc-ref first-patch "name"))))
+       (assq-ref details 'branch)))))
+
 (define* (latest-patchwork-series-by-issue
           #:key patchwork
           count)
@@ -231,6 +300,9 @@
                             (assq-ref mumi 'merged-with)))
                       (cons
                        `(,@data
+                         (branch . ,(or (parse-issue-title
+                                         (assq-ref mumi 'title))
+                                        (patchwork-series->branch data)))
                          (mumi . ,mumi))
                        result)
                       result)))
diff --git a/guix-qa-frontpage/server.scm b/guix-qa-frontpage/server.scm
index 8db6aae..e7b25d6 100644
--- a/guix-qa-frontpage/server.scm
+++ b/guix-qa-frontpage/server.scm
@@ -35,6 +35,8 @@
   #:use-module (guix store)
   #:use-module ((guix build syscalls)
                 #:select (set-thread-name))
+  #:use-module ((guix-data-service utils)
+                #:select (delete-duplicates/sort!))
   #:use-module (guix-data-service web util)
   #:use-module ((guix-data-service web query-parameters)
                 #:select (parse-query-string))
@@ -260,16 +262,13 @@
                          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<?))
+               (reverse
+                (delete-duplicates/sort!
+                 (map (lambda (series)
+                        (assq-ref series 'branch))
+                      latest-series)
+                 string<?)))
               (filtered-branches
                (filter-map
                 (match-lambda
@@ -280,7 +279,7 @@
                 query-params))
               (latest-series-with-overall-statuses
                (filter-map
-                (lambda (series branch)
+                (lambda (series)
                   (let ((overall-status
                          (with-sqlite-cache
                           database
@@ -288,7 +287,9 @@
                           (const 'unknown)
                           #:store-computed-value? #f
                           #:args (list (first series))
-                          #:ttl 3600)))
+                          #:ttl 3600))
+                        (branch
+                         (assq-ref series 'branch)))
                     (if (and (or (null? filtered-statuses)
                                  (member overall-status
                                          filtered-statuses))
@@ -298,8 +299,7 @@
                                 `((branch . ,branch)
                                   (overall-status . ,overall-status)))
                         #f)))
-                latest-series
-                latest-series-branches))
+                latest-series))
               (sorted-latest-series
                (sort
                 latest-series-with-overall-statuses
@@ -619,8 +619,6 @@
                      (select-create-branch-for-issue-log
                       database
                       number))
-                    (branch
-                     (patchwork-series->branch series))
                     (master-branch-substitute-availability
                      systems-with-low-substitute-availability
                      master-branch-package-reproducibility
@@ -633,7 +631,7 @@
                (render-html
                 #:sxml (issue-view number
                                    series
-                                   branch
+                                   (assq-ref series 'branch)
                                    (assq-ref (assq-ref series 'mumi)
                                              'tags)
                                    base-and-target-refs