diff options
| -rw-r--r-- | guix-qa-frontpage/server.scm | 17 | ||||
| -rw-r--r-- | guix-qa-frontpage/view/issue.scm | 27 |
2 files changed, 41 insertions, 3 deletions
diff --git a/guix-qa-frontpage/server.scm b/guix-qa-frontpage/server.scm index bf4a589..3b1df5d 100644 --- a/guix-qa-frontpage/server.scm +++ b/guix-qa-frontpage/server.scm @@ -370,7 +370,19 @@ issue-data #:args (list (string->number number)) - #:ttl 6000))) + #:ttl 6000)) + (master-branch-substitute-availability + (with-sqlite-cache + database + 'master-branch-data + master-branch-data + #:ttl 6000)) + (systems-with-low-substitute-availability + (get-systems-with-low-substitute-availability + master-branch-substitute-availability + (delete "i586-gnu" + %systems-to-submit-builds-for + string=?)))) (render-html #:sxml (issue-view number series @@ -383,7 +395,8 @@ derivation-changes-counts builds-missing? change-details - comparison-details))) + comparison-details + systems-with-low-substitute-availability))) (or (and=> (branch-for-issue database (string->number number)) diff --git a/guix-qa-frontpage/view/issue.scm b/guix-qa-frontpage/view/issue.scm index 5c2252c..9064832 100644 --- a/guix-qa-frontpage/view/issue.scm +++ b/guix-qa-frontpage/view/issue.scm @@ -13,7 +13,8 @@ comparison-link derivation-changes-counts builds-missing? - change-details comparison-details) + change-details comparison-details + systems-with-low-substitute-availability) (define* (package-derivations-comparison-link system #:key build-change) @@ -197,6 +198,30 @@ td.bad { (div (h3 "Package changes") + + ,@(if (or (not builds-missing?) + (eq? #f systems-with-low-substitute-availability) + (null? systems-with-low-substitute-availability)) + '() + `((p (@ (style ,(string-join + '("text-align: center;" + "font-weight: bold;" + "padding: 1rem;" + "max-width: 46rem;" + "border-width: 0.35em;" + "border-style: dashed;" + "border-color: red")))) + "Builds for this patch series not yet submitted as " + (a (@ (href "/branch/master")) + "master branch substitute availability") + " is low for: " + ,@(append-map + (lambda (system) + `((span (@ (style "font-family: monospace; white-space: nowrap;")) + ,system + " "))) + systems-with-low-substitute-availability)))) + (table (@ (style "border-collapse: collapse;")) (thead |