diff options
Diffstat (limited to 'guix-qa-frontpage/branch.scm')
-rw-r--r-- | guix-qa-frontpage/branch.scm | 199 |
1 files changed, 103 insertions, 96 deletions
diff --git a/guix-qa-frontpage/branch.scm b/guix-qa-frontpage/branch.scm index 5874120..be579f3 100644 --- a/guix-qa-frontpage/branch.scm +++ b/guix-qa-frontpage/branch.scm @@ -49,7 +49,7 @@ (lambda (m) (match:substring m 1)))) - (define merge-issues-by-branch + (define (merge-issues-by-branch) (filter-map (lambda (issue) (let ((branch (issue-title->branch @@ -67,102 +67,109 @@ ;; subject/title has changed "\"Request for merging\" is:open")))) - (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")) - (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-exception-handler + (lambda (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)) + (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 + (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))))))))))) + #:unwind? #t)) (define* (branch-data branch-name) (define branch-commit |