Fix non-master branch orderingHEADmaster

1 files changed, 107 insertions, 98 deletions

diff --git a/guix-qa-frontpage/branch.scm b/guix-qa-frontpage/branch.scm
index be579f3..7ce6ef5 100644
--- a/guix-qa-frontpage/branch.scm
+++ b/guix-qa-frontpage/branch.scm
@@ -60,7 +60,12 @@
            (cons branch
                  `(("issue_number" . ,issue-number)
                    ("issue_date" . ,(assoc-ref issue "date"))
-                   ("blocked_by" . ,(assoc-ref issue "blocked_by")))))))
+                   ("blocked_by"
+                    . ,(map (lambda (issue)
+                              (assoc-ref issue "number"))
+                            (or (and=> (assoc-ref issue "blocked_by")
+                                       vector->list)
+                                '()))))))))
      (vector->list
       (mumi-search-issues
        ;; TODO: subject: doesn't seem to work for issues where the
@@ -69,106 +74,110 @@
 
   (with-exception-handler
       (lambda (exn)
+        (simple-format #t "exception listing non master branches: ~A\n" exn)
         `((exception . ,(simple-format #f "~A" exn))))
     (lambda ()
-      (let* ((merge-issues
-              (merge-issues-by-branch))
-             (branches
-              (map
-               (lambda (branch)
-                 (let ((name (assoc-ref branch "name")))
-                   (cons name
-                         (append
-                          (or (assoc-ref merge-issues name)
-                              '())
-                          (alist-delete "name" branch)))))
-               (remove
-                (lambda (branch)
-                  (or (string=? (assoc-ref branch "name")
-                                "master")
-                      (string-prefix? "version-"
-                                      (assoc-ref branch "name"))
-                      (string=? (assoc-ref branch "commit")
-                                "")))
-                (list-branches
-                 (list-branches-url 2))))))
-        (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))
+      (with-throw-handler #t
+        (lambda ()
+          (let* ((merge-issues
+                  (merge-issues-by-branch))
+                 (branches
+                  (map
+                   (lambda (branch)
+                     (let ((name (assoc-ref branch "name")))
+                       (cons name
+                             (append
+                              (or (assoc-ref merge-issues name)
+                                  '())
+                              (alist-delete "name" branch)))))
+                   (remove
+                    (lambda (branch)
+                      (or (string=? (assoc-ref branch "name")
+                                    "master")
+                          (string-prefix? "version-"
+                                          (assoc-ref branch "name"))
+                          (string=? (assoc-ref branch "commit")
+                                    "")))
+                    (list-branches
+                     (list-branches-url 2))))))
+            (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)
+                       (and=> (assoc-ref (cdr branch) "issue_number")
+                              (lambda (issue-number)
+                                (cons issue-number index))))
                      (iota (length initial-ordered-branches))
-                     initial-ordered-branches))
-               (initial-ordering-index-by-issue-number
-                (filter-map
-                 (lambda (index branch)
-                   (and=> (assoc-ref (cdr branch) "issue_number")
-                          (lambda (issue-number)
-                            (cons 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
-                    (let ((ordering-indexes
-                           (filter-map
-                            (lambda (blocking-issue)
-                              (assq-ref initial-ordering-index-by-issue-number
-                                        blocking-issue))
-                            a-blocked-by)))
-                      (if (null? ordering-indexes)
-                          a-initial-ordering-index
-                          (apply max ordering-indexes))))
-                (if (null? b-blocked-by)
-                    b-initial-ordering-index
-                    (let ((ordering-indexes
-                           (filter-map
-                            (lambda (blocking-issue)
-                              (assq-ref initial-ordering-index-by-issue-number
-                                        blocking-issue))
-                            b-blocked-by)))
-                      (if (null? ordering-indexes)
-                          b-initial-ordering-index
-                          (apply max ordering-indexes)))))))))))
+                     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
+                        (or (assoc-ref (cdr a) "blocked_by") '()))
+                       (b-blocked-by
+                        (or (assoc-ref (cdr b) "blocked_by") '())))
+                   (<
+                    (if (null? a-blocked-by)
+                        a-initial-ordering-index
+                        (let ((ordering-indexes
+                               (filter-map
+                                (lambda (blocking-issue)
+                                  (and=>
+                                   (assq-ref
+                                    initial-ordering-index-by-issue-number
+                                    blocking-issue)
+                                   1+))
+                                a-blocked-by)))
+                          (if (null? ordering-indexes)
+                              a-initial-ordering-index
+                              (apply max ordering-indexes))))
+                    (if (null? b-blocked-by)
+                        b-initial-ordering-index
+                        (let ((ordering-indexes
+                               (filter-map
+                                (lambda (blocking-issue)
+                                  (and=>
+                                   (assq-ref
+                                    initial-ordering-index-by-issue-number
+                                    blocking-issue)
+                                   1+))
+                                b-blocked-by)))
+                          (if (null? ordering-indexes)
+                              b-initial-ordering-index
+                              (apply max ordering-indexes)))))))))))
+        (lambda args
+          (display (backtrace) (current-error-port))
+          (newline (current-error-port)))))
     #:unwind? #t))
 
 (define* (branch-data branch-name)