diff options
Diffstat (limited to 'guix-qa-frontpage/issue.scm')
| -rw-r--r-- | guix-qa-frontpage/issue.scm | 86 |
1 files changed, 50 insertions, 36 deletions
diff --git a/guix-qa-frontpage/issue.scm b/guix-qa-frontpage/issue.scm index 45603b5..cc4eebd 100644 --- a/guix-qa-frontpage/issue.scm +++ b/guix-qa-frontpage/issue.scm @@ -46,6 +46,7 @@ (define bad-status 'important-checks-failing) (define needs-looking-at-status 'needs-looking-at) (define unknown-status 'unknown) +(define large-number-of-builds-status 'large-number-of-builds) (define failed-to-apply-patches-status 'failed-to-apply-patches) (define patches-missing-status 'patches-missing) (define guix-data-service-failed-status 'guix-data-service-failed) @@ -53,6 +54,7 @@ (define %overall-statuses (list reviewed-looks-good-status good-status + large-number-of-builds-status unknown-status needs-looking-at-status failed-to-apply-patches-status @@ -99,43 +101,55 @@ (define derivation-changes-counts (assq-ref derivation-changes 'counts)) - (if builds-missing? - unknown-status - (if (null? derivation-changes-counts) - good-status - (worst-status - (map - (match-lambda - ((system . counts) - (define (count side status) - (assoc-ref (assoc-ref - counts - side) - status)) + (define builds-count + (and + derivation-changes + (length + (derivation-changes->builds-to-keep-and-submit derivation-changes + 0)))) + + (cond + ((and builds-count + (> builds-count %patches-builds-limit)) + large-number-of-builds-status) + (builds-missing? + unknown-status) + ((null? derivation-changes-counts) + good-status) + (else + (worst-status + (map + (match-lambda + ((system . counts) + (define (count side status) + (assoc-ref (assoc-ref + counts + side) + status)) - (let ((base-failure-count (count 'base 'failing)) - (target-failure-count (count 'target 'failing))) - (if (and (<= target-failure-count - base-failure-count) - (= (count 'target 'unknown) 0)) - good-status - (if (= (count 'target 'unknown) 0) - (let ((unblocked-builds - (- (count 'base 'blocked) - (count 'target 'blocked))) - (new-failures - (- target-failure-count - base-failure-count))) - (if (>= unblocked-builds - new-failures) - needs-looking-at-status - bad-status)) - unknown-status))))) - (filter - (lambda (builds-by-system) - (member (car builds-by-system) - %systems-to-consider)) - derivation-changes-counts)))))) + (let ((base-failure-count (count 'base 'failing)) + (target-failure-count (count 'target 'failing))) + (if (and (<= target-failure-count + base-failure-count) + (= (count 'target 'unknown) 0)) + good-status + (if (= (count 'target 'unknown) 0) + (let ((unblocked-builds + (- (count 'base 'blocked) + (count 'target 'blocked))) + (new-failures + (- target-failure-count + base-failure-count))) + (if (>= unblocked-builds + new-failures) + needs-looking-at-status + bad-status)) + unknown-status))))) + (filter + (lambda (builds-by-system) + (member (car builds-by-system) + %systems-to-consider)) + derivation-changes-counts)))))) (define tags-status (cond |