diff options
Diffstat (limited to 'guix-qa-frontpage/derivation-changes.scm')
| -rw-r--r-- | guix-qa-frontpage/derivation-changes.scm | 116 |
1 files changed, 56 insertions, 60 deletions
diff --git a/guix-qa-frontpage/derivation-changes.scm b/guix-qa-frontpage/derivation-changes.scm index cda0084..eab021e 100644 --- a/guix-qa-frontpage/derivation-changes.scm +++ b/guix-qa-frontpage/derivation-changes.scm @@ -21,7 +21,7 @@ #:use-module (srfi srfi-43) #:use-module (ice-9 match) #:export (categorise-packages - derivation-changes)) + derivation-changes-counts)) (define (categorise-packages derivation-changes side) (define (vector-member? s v) @@ -82,7 +82,7 @@ '() derivation-changes)) -(define (derivation-changes derivation-changes all-systems) +(define (derivation-changes-counts derivation-changes all-systems) (define categorised-base-packages-by-system (categorise-packages (assoc-ref derivation-changes "derivation_changes") @@ -93,61 +93,57 @@ "derivation_changes") "target")) - (define counts - (if (null? categorised-target-packages-by-system) - '() - (map - (match-lambda - ((system . categorised-target-builds) - (let ((categorised-base-builds - (assoc-ref categorised-base-packages-by-system - system))) - (cons - system - (map (lambda (side) - (cons side - (map (lambda (status) - (cons status - (length - (or - (assoc-ref - (if (eq? side 'base) - categorised-base-builds - categorised-target-builds) - status) - '())))) - '(succeeding failing blocked unknown)))) - '(base target)))))) - (sort - (append categorised-target-packages-by-system - (filter-map - (lambda (system) - (if (assoc-ref categorised-target-packages-by-system - system) - #f - (cons system '()))) - all-systems)) - (lambda (a b) - (let ((a-key (car a)) - (b-key (car b))) - (cond - ((and (string? a-key) - (string? b-key)) - (< (or (list-index - (lambda (s) - (string=? (car a) s)) - all-systems) - 10) - (or (list-index - (lambda (s) - (string=? (car b) s)) - all-systems) - 10))) - ((and (pair? a-key) - (pair? b-key)) - (string<? (cdr a-key) - (cdr b-key))) - (else #f)))))))) - - `(,@derivation-changes - (counts . ,counts))) + (if (null? categorised-target-packages-by-system) + '() + (map + (match-lambda + ((system . categorised-target-builds) + (let ((categorised-base-builds + (assoc-ref categorised-base-packages-by-system + system))) + (cons + system + (map (lambda (side) + (cons side + (map (lambda (status) + (cons status + (length + (or + (assoc-ref + (if (eq? side 'base) + categorised-base-builds + categorised-target-builds) + status) + '())))) + '(succeeding failing blocked unknown)))) + '(base target)))))) + (sort + (append categorised-target-packages-by-system + (filter-map + (lambda (system) + (if (assoc-ref categorised-target-packages-by-system + system) + #f + (cons system '()))) + all-systems)) + (lambda (a b) + (let ((a-key (car a)) + (b-key (car b))) + (cond + ((and (string? a-key) + (string? b-key)) + (< (or (list-index + (lambda (s) + (string=? (car a) s)) + all-systems) + 10) + (or (list-index + (lambda (s) + (string=? (car b) s)) + all-systems) + 10))) + ((and (pair? a-key) + (pair? b-key)) + (string<? (cdr a-key) + (cdr b-key))) + (else #f)))))))) |