Improve ordering issues

Use the blocking information as well.

I haven't really tested these changes yet as currently there is just one
branch with an issue, but hopefully it's a step in the right direction.

2 files changed, 74 insertions, 28 deletions

diff --git a/guix-qa-frontpage/branch.scm b/guix-qa-frontpage/branch.scm
index fee5078..6b1008b 100644
--- a/guix-qa-frontpage/branch.scm
+++ b/guix-qa-frontpage/branch.scm
@@ -57,9 +57,8 @@
          (when (assoc-ref issue "open")
            (cons branch
                  `(("issue_number" . ,issue-number)
-                   ("issue_date" . ,(assoc-ref issue "date")))))))
-       ;; TODO: Mumi doesn't expose this yet
-       ;; ,@(mumi-issue-blocking-info issue-number)))))
+                   ("issue_date" . ,(assoc-ref issue "date"))
+                   ("blocked_by" . ,(assoc-ref issue "blocked_by")))))))
      (vector->list
       (mumi-search-issues
        ;; TODO: Finalise this
@@ -79,24 +78,79 @@
              (or (string=? (assoc-ref branch "name")
                            "master")
                  (string-prefix? "version-"
-                                 (assoc-ref branch "name"))))
+                                 (assoc-ref branch "name"))
+                 (string=? (assoc-ref branch "commit")
+                           "")))
            (list-branches
             (list-branches-url 2))))))
-    (stable-sort
-     branches
-     (lambda (a b)
-       (let ((a-has-issue
-              (->bool (assoc-ref (cdr a) "issue_number")))
-             (b-has-issue
-              (->bool (assoc-ref (cdr b) "issue_number"))))
-         (if (and a-has-issue b-has-issue)
-             ;; TODO: Sort by blocking info
-             (let ((a-date
-                    (assoc-ref (cdr a) "issue_date"))
-                   (b-date
-                    (assoc-ref (cdr b) "issue_date")))
-               (string<? a-date b-date))
-             a-has-issue))))))
+    (let* ((initial-ordered-branches
+            (stable-sort
+             branches
+             (lambda (a b)
+               (let ((a-has-issue
+                      (->bool (assoc-ref (cdr a) "issue_number")))
+                     (b-has-issue
+                      (->bool (assoc-ref (cdr b) "issue_number"))))
+                 (if (and a-has-issue b-has-issue)
+                     (let ((a-date
+                            (assoc-ref (cdr a) "issue_date"))
+                           (b-date
+                            (assoc-ref (cdr b) "issue_date")))
+                       (string<? a-date b-date))
+                     a-has-issue)))))
+           (initial-ordering-index-by-branch
+            (map (lambda (index branch)
+                   (cons (car branch) index))
+                 (iota (length initial-ordered-branches))
+                 initial-ordered-branches))
+           (initial-ordering-index-by-issue-number
+            (filter-map
+             (lambda (index branch)
+               (cons (assoc-ref (cdr branch) "issue_number")
+                     index))
+             (iota (length initial-ordered-branches))
+             initial-ordered-branches)))
+
+      ;; The idea with issues blocking others is to create a linked list,
+      ;; however I think it's possible to have a loop in the blocking directed
+      ;; graph, so try to not completely fail if this is the case.
+      (stable-sort
+       initial-ordered-branches
+       (lambda (a b)
+         (let ((a-initial-ordering-index
+                (assq-ref initial-ordering-index-by-branch
+                          (car a)))
+               (b-initial-ordering-index
+                (assq-ref initial-ordering-index-by-branch
+                          (car b)))
+
+               (a-blocked-by
+                (map (lambda (issue)
+                       (assoc-ref issue "number"))
+                     (or (and=> (assoc-ref (cdr a) "blocked_by")
+                                vector->list)
+                         '())))
+               (b-blocked-by
+                (map (lambda (issue)
+                       (assoc-ref issue "number"))
+                     (or (and=> (assoc-ref (cdr b) "blocked_by")
+                                vector->list)
+                         '()))))
+           (<
+            (if (null? a-blocked-by)
+                a-initial-ordering-index
+                (apply max
+                       (map (lambda (blocking-issue)
+                              (assq-ref initial-ordering-index-by-issue-number
+                                        (assoc-ref blocking-issue "number")))
+                            a-blocked-by)))
+            (if (null? b-blocked-by)
+                b-initial-ordering-index
+                (apply max
+                       (map (lambda (blocking-issue)
+                              (assq-ref initial-ordering-index-by-issue-number
+                                        (assoc-ref blocking-issue "number")))
+                            b-blocked-by))))))))))
 
 (define* (branch-data branch-name)
   (let* ((branch-commit
diff --git a/guix-qa-frontpage/mumi.scm b/guix-qa-frontpage/mumi.scm
index ce6a435..8298e3d 100644
--- a/guix-qa-frontpage/mumi.scm
+++ b/guix-qa-frontpage/mumi.scm
@@ -29,8 +29,6 @@
                 #:select (retry-on-error))
   #:export (mumi-search-issues
 
-            mumi-issue-blocking-info
-
             mumi-issue-open?
 
             mumi-bulk-issues))
@@ -72,17 +70,11 @@
     (lambda ()
       (let ((response
              (graphql-http-get "https://issues.guix.gnu.org/graphql"
-                               `(document (query (#(issues #:search ,query) number title date open))))))
+                               `(document (query (#(issues #:search ,query) number title date open (blocked_by number)))))))
         (assoc-ref response
                    "issues")))
     #:unwind? #t))
 
-(define (mumi-issue-blocking-info number)
-  (let ((response
-         (graphql-http-get "https://issues.guix.gnu.org/graphql"
-                           `(document (query (#(issue #:number ,number) blockedby blocks))))))
-    (cdr (first response))))
-
 (define (mumi-issue-open? number)
   (let ((response
          (graphql-http-get "https://issues.guix.gnu.org/graphql"