diff options
Diffstat (limited to 'guix-qa-frontpage')
-rw-r--r-- | guix-qa-frontpage/branch.scm | 47 |
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 |