From f05af4479d6c41907a282be1a1bf3a42a8671b6d Mon Sep 17 00:00:00 2001 From: Christopher Baines Date: Sat, 31 Oct 2020 15:53:50 +0000 Subject: [PATCH] Add a way of displaying build statuses as small labels --- guix-data-service/web/html-utils.scm | 38 +++++++++++++++++++++++++++- 1 file changed, 37 insertions(+), 1 deletion(-) diff --git a/guix-data-service/web/html-utils.scm b/guix-data-service/web/html-utils.scm index 660fcd3..5c0730d 100644 --- a/guix-data-service/web/html-utils.scm +++ b/guix-data-service/web/html-utils.scm @@ -27,7 +27,8 @@ build-status-span build-url build-server-link-url - build-status-alist->build-icon)) + build-status-alist->build-icon + build-statuses->build-status-labels)) (define (sexp-div sexp) (match sexp @@ -116,3 +117,38 @@ (define (build-status-alist->build-icon status) (build-status-span (assoc-ref status "status"))) + +(define (build-status-label status count) + `(span (@ (class ,(string-append + "pull-right label label-" + (assoc-ref + '(("scheduled" . "info") + ("started" . "primary") + ("succeeded" . "success") + ("failed" . "danger") + ("failed-dependency" . "warning") + ("failed-other" . "danger") + ("canceled" . "default") + ("" . "default")) + status)))) + ,count)) + +(define (build-statuses->build-status-labels builds) + (define statuses-and-counts + (fold (lambda (status counts) + `((,status . ,(+ 1 + (or (assoc-ref counts status) + 0))) + ,@(alist-delete status counts))) + '() + (sort + (map (lambda (build) + (assoc-ref build "status")) + builds) + string