diff options
| author | Christopher Baines <mail@cbaines.net> | 2023-03-11 11:26:30 +0000 |
|---|---|---|
| committer | Christopher Baines <mail@cbaines.net> | 2023-03-11 11:26:30 +0000 |
| commit | e7d3c6464df33b759718d8747e8a32be74d2957a (patch) | |
| tree | 90970f993d9a4da0c66f362c111da1326b7f8b37 /guix-qa-frontpage/derivation-changes.scm | |
| parent | 464e60e606e80b93969ed95a1e03d17aa31c5308 (diff) | |
| download | qa-frontpage-e7d3c6464df33b759718d8747e8a32be74d2957a.tar qa-frontpage-e7d3c6464df33b759718d8747e8a32be74d2957a.tar.gz | |
Rework the branch page and data
This should address the performance problems, and begin to make this page
useful.
Diffstat (limited to 'guix-qa-frontpage/derivation-changes.scm')
| -rw-r--r-- | guix-qa-frontpage/derivation-changes.scm | 52 |
1 files changed, 51 insertions, 1 deletions
diff --git a/guix-qa-frontpage/derivation-changes.scm b/guix-qa-frontpage/derivation-changes.scm index f339dce..fa286a3 100644 --- a/guix-qa-frontpage/derivation-changes.scm +++ b/guix-qa-frontpage/derivation-changes.scm @@ -20,7 +20,8 @@ #:use-module (srfi srfi-1) #:use-module (ice-9 match) #:export (builds-by-system-excluding-cross-builds - categorise-builds)) + categorise-builds + derivation-changes-counts)) (define (builds-by-system-excluding-cross-builds derivation-changes side) (fold (lambda (package result) @@ -123,3 +124,52 @@ (filter (lambda (system) (not (member system systems))) all-systems))))) + +(define (derivation-changes-counts derivation-changes all-systems) + (let* ((base-builds + (builds-by-system-excluding-cross-builds + derivation-changes "base")) + (target-builds + (builds-by-system-excluding-cross-builds + derivation-changes "target")) + + (categorised-base-builds-by-system + (categorise-builds all-systems base-builds)) + (categorised-target-builds-by-system + (categorise-builds all-systems target-builds))) + + (if (null? target-builds) + '() + (map + (match-lambda + ((system . categorised-target-builds) + (let ((categorised-base-builds + (assoc-ref categorised-base-builds-by-system + system))) + (cons + system + (map (lambda (side) + (cons side + (map (lambda (status) + (cons status + (length + (assoc-ref + (if (eq? side 'base) + categorised-base-builds + categorised-target-builds) + status)))) + '(succeeding failing blocked unknown)))) + '(base target)))))) + (sort + categorised-target-builds-by-system + (lambda (a b) + (< (or (list-index + (lambda (s) + (string=? (car a) s)) + all-systems) + 10) + (or (list-index + (lambda (s) + (string=? (car b) s)) + all-systems) + 10)))))))) |