diff options
Diffstat (limited to 'guix-qa-frontpage/view')
| -rw-r--r-- | guix-qa-frontpage/view/branch.scm | 170 |
1 files changed, 72 insertions, 98 deletions
diff --git a/guix-qa-frontpage/view/branch.scm b/guix-qa-frontpage/view/branch.scm index 9606564..7589923 100644 --- a/guix-qa-frontpage/view/branch.scm +++ b/guix-qa-frontpage/view/branch.scm @@ -6,7 +6,7 @@ #:use-module (guix-qa-frontpage view util) #:export (branch-view)) -(define (branch-view branch derivation-changes) +(define (branch-view branch change-details derivation-changes-counts) (define* (package-derivations-comparison-link system #:key build-change) (let ((revisions @@ -34,109 +34,83 @@ (thead (tr (th (@ (rowspan 3)) "System") - (th (@ (colspan 6)) "Package build status") + (th (@ (colspan 8)) "Package build status") (th)) (tr - (th (@ (colspan 3)) "Base") - (th (@ (colspan 3)) "With patches applied") + (th (@ (colspan 4)) "Base") + (th (@ (colspan 4) + (style "border-left-width: 0.1em; border-left-style: solid; border-left-color: black")) + "With branch changes") (th)) (tr - (th (@ (style "min-width: 5rem;")) - "Succeeding") - (th (@ (style "min-width: 5rem;")) - "Failing") - (th (@ (style "min-width: 5rem;")) - "Unknown") - (th (@ (style "min-width: 5rem;")) - "Succeeding") - (th (@ (style "min-width: 5rem;")) - "Failing") - (th (@ (style "min-width: 5rem;")) - "Unknown") - (th))) + ,@(let ((header-style + "font-size: 80%; min-width: 3.5rem;")) + `((th (@ (style ,header-style)) + "Succeeding") + (th (@ (style ,header-style)) + "Failing") + (th (@ (style ,header-style)) + "Blocked") + (th (@ (style ,header-style)) + "Unknown") + (th (@ (style + ,(string-append + header-style + " border-left-width: 0.125em; border-left-style: solid; border-left-color: black;"))) + "Succeeding") + (th (@ (style ,header-style)) + "Failing") + (th (@ (style ,header-style)) + "Blocked") + (th (@ (style ,header-style)) + "Unknown") + (th))))) (tbody - ,@(if derivation-changes - (let* ((base-builds - (builds-by-system-excluding-cross-builds - derivation-changes "base")) - (target-builds - (builds-by-system-excluding-cross-builds - derivation-changes "target")) + ,@(if derivation-changes-counts + (if (null? derivation-changes-counts) + `((tr + (td (@ (colspan 7)) + "No package derivation changes"))) + (map + (match-lambda + ((system . counts) - (all-systems - (delete-duplicates - (append! (map car base-builds) - (map car target-builds)))) - - (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) - `((tr - (td (@ (colspan 7)) - "No package derivation changes"))) - (map - (match-lambda - ((system . categorised-target-builds) - (let ((categorised-base-builds - (assoc-ref categorised-base-builds-by-system - system)) - (highlighed-common - " ")) - (define (count side status) - (length - (assoc-ref - (if (eq? side 'base) - categorised-base-builds - categorised-target-builds) - status))) - - `(tr - (td (@ (class "monospace")) ,system) - ,@(map (lambda (status) - `(td ,(count 'base status))) - '(succeeding failing unknown)) - (td ,@(if (and (>= (count 'target 'succeeding) - (count 'base 'succeeding)) - (> (count 'target 'succeeding) - 0)) - `((@ (class "good"))) - '()) - ,(count 'target 'succeeding)) - ,(if (> (count 'target 'failing) - (count 'base 'failing)) - `(td (@ (class "bad")) - (a ;; (@ (href ,(package-derivations-comparison-link - ;; system - ;; #:build-change "broken"))) - ,(count 'target 'failing))) - `(td ,(count 'target 'failing))) - ,(if (> (count 'target 'unknown) - (count 'base 'unknown)) - `(td (@ (class "bad")) - (a ;; (@ (href ,(package-derivations-comparison-link - ;; system - ;; #:build-change "unknown"))) - ,(count 'target 'unknown))) - `(td ,(count 'target 'unknown))) - (td (a ;; (@ (href - ;; ,(package-derivations-comparison-link system))) - "View comparison")))))) - (sort - categorised-target-builds-by-system - (lambda (a b) - (< (or (list-index - (lambda (s) - (string=? (car a) s)) - %systems-to-submit-builds-for) - 10) - (or (list-index - (lambda (s) - (string=? (car b) s)) - %systems-to-submit-builds-for) - 10))))))) + (define (count side status) + (assoc-ref (assoc-ref + counts + side) + status)) + `(tr + (td (@ (class "monospace")) ,system) + ,@(map (lambda (status) + `(td ,(count 'base status))) + '(succeeding failing blocked unknown)) + (td ,@(if (and (>= (count 'target 'succeeding) + (count 'base 'succeeding)) + (> (count 'target 'succeeding) + 0)) + `((@ (class "good"))) + '()) + ,(count 'target 'succeeding)) + ,(if (> (count 'target 'failing) + (count 'base 'failing)) + `(td (@ (class "bad")) + ,(count 'target 'failing)) + `(td ,(count 'target 'failing))) + ,(if (> (count 'target 'blocked) + (count 'base 'blocked)) + `(td (@ (class "bad")) + ,(count 'target 'blocked)) + `(td ,(count 'target 'blocked))) + ,(if (> (count 'target 'unknown) + (count 'base 'unknown)) + `(td (@ (class "bad")) + ,(count 'target 'unknown)) + `(td ,(count 'target 'unknown))) + (td (a (@ (href + ,(package-derivations-comparison-link system))) + "View comparison"))))) + derivation-changes-counts)) '((tr (td (@ (colspan 7)) "Comparison unavailable"))))))))))) |