Add a way of listing branches with associated issues

1 files changed, 46 insertions, 1 deletions

diff --git a/guix-qa-frontpage/branch.scm b/guix-qa-frontpage/branch.scm
index 60ce2a6..345f49b 100644
--- a/guix-qa-frontpage/branch.scm
+++ b/guix-qa-frontpage/branch.scm
@@ -18,24 +18,69 @@
 
 (define-module (guix-qa-frontpage branch)
   #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-43)
   #:use-module (srfi srfi-71)
   #:use-module (ice-9 match)
+  #:use-module (ice-9 regex)
   #:use-module (ice-9 threads)
   #:use-module (prometheus)
   #:use-module ((guix-build-coordinator utils)
                 #:select (with-time-logging))
+  #:use-module (guix-qa-frontpage mumi)
   #:use-module (guix-qa-frontpage git-repository)
   #:use-module (guix-qa-frontpage guix-data-service)
   #:use-module (guix-qa-frontpage derivation-changes)
   #:use-module (guix-qa-frontpage database)
   #:use-module (guix-qa-frontpage manage-builds)
-  #:export (branch-data
+  #:export (list-non-master-branches
+
+            branch-data
             master-branch-data
 
             get-systems-with-low-substitute-availability
 
             start-refresh-non-patch-branches-data-thread))
 
+(define (list-non-master-branches)
+  (define (issue-title->branch title)
+    (match:substring
+     (string-match ".* \"([^\"]*)\" .*" title)
+     1))
+
+  (define merge-issues-by-branch
+    (map
+     (lambda (issue)
+       (let ((branch (issue-title->branch
+                      (assoc-ref issue "title"))))
+         (cons branch
+               `(("issue_number" . ,(assoc-ref issue "number"))))))
+     (vector->list
+      (mumi-search-issues
+       ;; TODO: Finalise this
+       "subject:\"Request for merging\""))))
+
+  (let ((branches
+         (map
+          (lambda (branch)
+            (let ((name (assoc-ref branch "name")))
+              (cons name
+                    (append
+                     (or (assoc-ref merge-issues-by-branch name)
+                         '())
+                     (alist-delete "name" branch)))))
+          (remove
+           (lambda (branch)
+             (or (string=? (assoc-ref branch "name")
+                           "master")
+                 (string-prefix? "version-"
+                                 (assoc-ref branch "name"))))
+           (list-branches
+            (list-branches-url 2))))))
+    (stable-sort
+     branches
+     (lambda (a b)
+       (not (assoc-ref (cdr b) "issue_number"))))))
+
 (define* (branch-data branch-name)
   (let* ((branch-commit
           (get-commit