diff options
| author | Christopher Baines <mail@cbaines.net> | 2023-06-02 10:26:37 +0100 |
|---|---|---|
| committer | Christopher Baines <mail@cbaines.net> | 2023-06-02 10:26:37 +0100 |
| commit | ba394b3b431d84c08a55f2d981d850625202e6c5 (patch) | |
| tree | a747629f29225ff441bc5344a79d99919b144475 | |
| parent | 94534933deebc31721024bd32bbb0d494c121fa9 (diff) | |
| download | qa-frontpage-ba394b3b431d84c08a55f2d981d850625202e6c5.tar qa-frontpage-ba394b3b431d84c08a55f2d981d850625202e6c5.tar.gz | |
Highlight when branches are out of date
| -rw-r--r-- | guix-qa-frontpage/branch.scm | 14 | ||||
| -rw-r--r-- | guix-qa-frontpage/server.scm | 4 | ||||
| -rw-r--r-- | guix-qa-frontpage/view/branch.scm | 25 |
3 files changed, 40 insertions, 3 deletions
diff --git a/guix-qa-frontpage/branch.scm b/guix-qa-frontpage/branch.scm index 14e13fd..a704d57 100644 --- a/guix-qa-frontpage/branch.scm +++ b/guix-qa-frontpage/branch.scm @@ -110,6 +110,17 @@ `((base . ,merge-base) (target . ,branch-commit))) + (up-to-date-with-master? + (let ((changes + (length + (revision-derivation-changes + (revision-derivation-changes-url + revisions + ;; TODO: Maybe do something smarter here? + #:systems '("x86_64-linux")))))) + `((up-to-date? . ,(< changes 3000)) + (changes . ,changes)))) + (derivation-changes-counts (with-exception-handler (lambda (exn) @@ -161,7 +172,8 @@ (values revisions derivation-changes-counts - substitute-availability))) + substitute-availability + up-to-date-with-master?))) (define* (master-branch-data) (let* ((substitute-availability diff --git a/guix-qa-frontpage/server.scm b/guix-qa-frontpage/server.scm index 3b1df5d..094045d 100644 --- a/guix-qa-frontpage/server.scm +++ b/guix-qa-frontpage/server.scm @@ -138,6 +138,7 @@ (let ((revisions derivation-changes-counts substitute-availability + up-to-date-with-master (with-sqlite-cache database 'branch-data @@ -150,7 +151,8 @@ (branch-view branch revisions derivation-changes-counts - substitute-availability)))) + substitute-availability + up-to-date-with-master)))) (('GET "patches") (let* ((latest-series (with-sqlite-cache diff --git a/guix-qa-frontpage/view/branch.scm b/guix-qa-frontpage/view/branch.scm index b6cc81f..c2a02ec 100644 --- a/guix-qa-frontpage/view/branch.scm +++ b/guix-qa-frontpage/view/branch.scm @@ -10,7 +10,8 @@ master-branch-view)) (define (branch-view branch revisions derivation-changes-counts - substitute-availability) + substitute-availability + up-to-date-with-master) (define* (package-derivations-comparison-link system #:key build-change) (string-append @@ -41,6 +42,28 @@ td.bad { }")) #:body `((main + ,@(if (assq-ref up-to-date-with-master 'up-to-date?) + '() + `((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")))) + "To many changes (" + ,(assq-ref up-to-date-with-master 'changes) + " for " + (span (@ (style "font-family: monospace;")) + "x86_64-linux") + ") between " + (a (@ (href ,(string-append + "https://data.qa.guix.gnu.org/revision/" + (assq-ref revisions 'base)))) + "merge base") + " and master, this branch should be rebased or master merged in."))) + (h2 "Substitute availability") (div ,@(if substitute-availability |