[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
03/05: Add a way of displaying build statuses as small labels
From: |
Christopher Baines |
Subject: |
03/05: Add a way of displaying build statuses as small labels |
Date: |
Sat, 31 Oct 2020 11:56:08 -0400 (EDT) |
cbaines pushed a commit to branch master
in repository data-service.
commit f05af4479d6c41907a282be1a1bf3a42a8671b6d
Author: Christopher Baines <mail@cbaines.net>
AuthorDate: Sat Oct 31 15:53:50 2020 +0000
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<?)))
+
+ (map
+ (match-lambda
+ ((status . count)
+ (build-status-label status count)))
+ statuses-and-counts))