guix/guix-cuirass
2
0
Fork 0
mirror of git://git.savannah.gnu.org/guix/guix-cuirass.git synced 2024-12-29 11:40:16 +01:00
Code Issues Releases Wiki Activity

Display failing specification in the main page.

Browse source 
* src/cuirass/database.scm (db-get-latest-evaluations): Add a status
parameter.
* src/cuirass/templates.scm (specifications-table): Add a latest-evaluations
parameter.
* src/cuirass/http.scm (url-handler): Adapt it.
* tests/database.scm (db-get-latest-evaluations 2): New test.
This commit is contained in:
Mathieu Othacehe 2021-12-01 12:31:07 +01:00
parent da377832ce
commit 2d76216af7
No known key found for this signature in database
GPG key ID: 8354763531769CA6
4 changed files with 81 additions and 44 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

18
src/cuirass/database.scm
View file

@ -1561,12 +1561,19 @@ WHERE status = 0 AND specification = " spec
((eval) (and eval (string->number eval))) ((eval) (and eval (string->number eval)))
(else #f)))) (else #f))))
(define (db-get-latest-evaluations) (define* (db-get-latest-evaluations
"Return the latest successful evaluation for each specification." #:key (status (evaluation-status succeeded)))
"Return the latest evaluation for each specification. Only consider
evaluations with the given STATUS. If status is #f, the latest evaluation is
returned regardless of its status."
(with-db-worker-thread db (with-db-worker-thread db
(let loop ((rows (exec-query db " (let loop ((rows (if status
(exec-query/bind db "
SELECT specification, max(id) FROM Evaluations SELECT specification, max(id) FROM Evaluations
WHERE status = 0 GROUP BY Evaluations.specification;")) WHERE status = " status " GROUP BY Evaluations.specification;")
(exec-query/bind db "
SELECT specification, max(id) FROM Evaluations
GROUP BY Evaluations.specification;") ))
(evaluations '())) (evaluations '()))
(match rows (match rows
(() (reverse evaluations)) (() (reverse evaluations))
@ -1575,7 +1582,8 @@ WHERE status = 0 GROUP BY Evaluations.specification;"))
(loop rest (loop rest
(cons `((#:specification . ,specification) (cons `((#:specification . ,specification)
(#:evaluation (#:evaluation
. ,(string->number evaluation))) . ,(and=> (string->number evaluation)
db-get-evaluation)))
evaluations))))))) evaluations)))))))
(define (db-get-evaluation-summary id) (define (db-get-evaluation-summary id)

9
src/cuirass/http.scm
View file

@ -889,8 +889,13 @@ passed, only display JOBS targeting this SYSTEM."
evals evals
(db-get-evaluations-absolute-summary (db-get-evaluations-absolute-summary
(map (lambda (e) (map (lambda (e)
`((#:id . ,(assq-ref e #:evaluation)))) `((#:id . ,(assq-ref
evals)))) (assq-ref e #:evaluation)
#:id))))
evals))
;; Get all the latest evaluations, regardless of their
;; status.
(db-get-latest-evaluations #:status #f)))
'()))) '())))
(('GET "dashboard" id) (('GET "dashboard" id)
(let ((dashboard (db-get-dashboard id))) (let ((dashboard (db-get-dashboard id)))

90
src/cuirass/templates.scm
View file

@ -252,16 +252,24 @@ system whose names start with " (code "guile-") ":" (br)
(else (else
"Invalid status"))) "Invalid status")))
(define (specifications-table specs evaluations summaries) (define (specifications-table specs evaluations summaries latest-evaluations)
(define (spec->latest-eval name) (define (spec->latest-eval-ok name)
(find (lambda (s) (find (lambda (s)
(string=? (assq-ref s #:specification) name)) (string=? (assq-ref s #:specification) name))
evaluations)) evaluations))
(define (spec->latest-eval name)
(any (lambda (s)
(and (string=? (assq-ref s #:specification) name)
(assq-ref s #:evaluation)))
latest-evaluations))
(define (eval-summary eval) (define (eval-summary eval)
(find (lambda (s) (find (lambda (s)
(eq? (assq-ref s #:evaluation) (eq? (assq-ref s #:evaluation)
(assq-ref eval #:evaluation))) (assq-ref
(assq-ref eval #:evaluation)
#:id)))
summaries)) summaries))
(define (summary->percentage summary) (define (summary->percentage summary)
@ -352,50 +360,60 @@ system whose names start with " (code "guile-") ":" (br)
(style "vertical-align: middle")) (style "vertical-align: middle"))
,@(let* ((summary ,@(let* ((summary
(eval-summary (eval-summary
(spec->latest-eval (spec->latest-eval-ok
(specification-name spec)))) (specification-name spec))))
(last-eval
(spec->latest-eval
(specification-name spec)))
(last-eval-status-ok?
(<= (assq-ref last-eval #:status)
(evaluation-status succeeded)))
(percentage (percentage
(and summary (summary->percentage summary))) (and summary (summary->percentage summary)))
(style (style
(format #f "width: ~a%" percentage))) (format #f "width: ~a%" percentage)))
(if summary (cond
`((div ((and summary last-eval-status-ok?)
(@ (class "progress job-abs") `((div
(title "Percentage succeeded")) (@ (class "progress job-abs")
(div (@ (class "progress-bar") (title "Percentage succeeded"))
(role "progressbar") (div (@ (class "progress-bar")
(style ,style) (role "progressbar")
(aria-valuemin "0") (style ,style)
(aria-valuemax "100")) (aria-valuemin "0")
(strong (aria-valuemax "100"))
(span (strong
(@ (class "text-dark")) (span
,percentage (@ (class "text-dark"))
"%")))) ,percentage
" " "%"))))
(div " "
(@ (class "job-rel d-none")) (div
(div (@ (class "job-rel d-none"))
(@ (class "badge badge-success") (div
(title "Succeeded")) (@ (class "badge badge-success")
,(assq-ref summary #:succeeded)) (title "Succeeded"))
(div ,(assq-ref summary #:succeeded))
(@ (class "badge badge-danger") (div
(title "Failed")) (@ (class "badge badge-danger")
,(assq-ref summary #:failed)) (title "Failed"))
(div ,(assq-ref summary #:failed))
(@ (class "badge badge-secondary") (div
(title "Scheduled")) (@ (class "badge badge-secondary")
,(assq-ref summary #:scheduled)))) (title "Scheduled"))
'()))) ,(assq-ref summary #:scheduled)))))
((not last-eval-status-ok?)
`((center
,@(evaluation-badges last-eval #f))))
(else '()))))
(td (td
,@(let* ((name (specification-name spec)) ,@(let* ((name (specification-name spec))
(dashboard-name (dashboard-name
(string-append "Dashboard " name)) (string-append "Dashboard " name))
(eval (and=> (spec->latest-eval name) (eval (and=> (spec->latest-eval-ok name)
(cut assq-ref <> #:evaluation)))) (cut assq-ref <> #:evaluation))))
(if eval (if eval
`((a (@ (href "/eval/" ,eval `((a (@ (href "/eval/" ,(assq-ref eval #:id)
"/dashboard")) "/dashboard"))
(div (div
(@ (class "oi oi-monitor d-inline-block ml-2") (@ (class "oi oi-monitor d-inline-block ml-2")

8
tests/database.scm
View file

@ -386,7 +386,13 @@ timestamp, checkouttime, evaltime) VALUES ('guix', 0, 0, 0, 0);")
4 4
(match (db-get-latest-evaluations) (match (db-get-latest-evaluations)
((eval) ((eval)
(assq-ref eval #:evaluation)))) (assq-ref (assq-ref eval #:evaluation) #:id))))
(test-equal "db-get-latest-evaluations 2"
4
(match (db-get-latest-evaluations #:status #f)
((eval)
(assq-ref (assq-ref eval #:evaluation) #:id))))
(test-equal "db-get-evaluation-summary" (test-equal "db-get-evaluation-summary"
'(2 0 1 1) '(2 0 1 1)