guix/guix-cuirass
2
0
Fork 0
mirror of git://git.savannah.gnu.org/guix/guix-cuirass.git synced 2023-12-14 06:03:04 +01:00
Code Issues Releases Wiki Activity

Improve workers page.

Browse source 
* src/cuirass/templates.scm (workers-status): Improve display.
* src/cuirass/http.scm (url-handler): Adapt it.
This commit is contained in:
Mathieu Othacehe 2021-01-30 14:24:29 +01:00
parent 213683ad27
commit 1e8d075d70
No known key found for this signature in database
GPG key ID: 8354763531769CA6
2 changed files with 65 additions and 32 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

20
src/cuirass/http.scm
View file

@ -651,15 +651,17 @@ Hydra format."
(respond-html
(html-page
"Workers status"
(let ((workers (db-get-workers)))
(workers-status
workers
(map (lambda (worker)
(let ((name (worker-name worker)))
(db-get-builds `((worker . ,name)
(status . started)
(order . status+submission-time)))))
workers)))
(let* ((workers (db-get-workers))
(builds (db-get-builds `((status . started)
(order . status+submission-time))))
(builds* (map (lambda (build)
(let* ((id (assoc-ref build #:id))
(percentage
(db-get-build-percentage id)))
`(,@build
(#:percentage . ,percentage))))
builds)))
(workers-status workers builds*))
'())))
(('GET "metrics")

77
src/cuirass/templates.scm
View file

@ -1033,27 +1033,58 @@ completed builds divided by the time required to build them.")
(td (a (@ (href "/build/" ,(assq-ref build #:id) "/log/raw"))
"raw"))))
(define (worker-header worker)
`((p ,(integer->char 128994)
" "
(b ,(worker-name worker))
,(format #f " (~a, ~{~a ~})"
(worker-address worker)
(worker-systems worker)))))
(define (machine-row machine)
(let* ((workers (filter (lambda (worker)
(string=? (worker-machine worker)
machine))
workers))
(builds
(map (lambda (worker)
(match (filter
(lambda (build)
(let ((name (worker-name worker)))
(let ((build-worker
(assq-ref build #:worker)))
(and build-worker
(string=? build-worker name)))))
builds)
(() #f)
((build) build)))
workers)))
`(div (@ (class "col-sm-4 mt-3"))
(h6 ,machine)
,(map (lambda (worker build)
(let ((name (worker-name worker))
(style (format #f
"width: ~a%"
(if build
(assq-ref build #:percentage)
0))))
`(div (@ (class "progress mt-1")
(style "height: 20px"))
(div (@ (class "progress-bar")
(role "progressbar")
(style ,style)
(aria-valuemin "0")
(aria-valuemax "100"))
,(if build
`(strong
(@ (class "justify-content-center
d-flex position-absolute w-100"))
(a (@ (class "text-dark")
(href "/build/"
,(assq-ref build #:id)
"/details"))
,(assq-ref build #:job-name)))
'(em
(@ (class "justify-content-center
text-dark d-flex position-absolute w-100"))
"idle"))))))
workers builds))))
(define (worker-table worker builds)
`(,@(worker-header worker)
(table
(@ (class "table table-sm table-hover table-striped"))
,@(if (null? builds)
`((th (@ (scope "col")) "Idle"))
`((thead (tr (th (@ (scope "col")) "ID")
(th (@ (scope "col")) "Job")
(th (@ (scope "col")) "Queued at")
(th (@ (scope "col")) "System")
(th (@ (scope "col")) "Log")))
(tbody
,(map build-row builds)))))))
`((p (@ (class "lead")) "Workers status")
,@(map worker-table workers builds)))
(let ((machines (delete-duplicates
(map worker-machine workers))))
`((p (@ (class "lead")) "Workers status")
(div (@ (class "container"))
(div (@ (class "row"))
,@(map machine-row machines))))))