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)))
(else #f))))
(define (db-get-latest-evaluations)
"Return the latest successful evaluation for each specification."
(define* (db-get-latest-evaluations
#: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
(let loop ((rows (exec-query db "
(let loop ((rows (if status
(exec-query/bind db "
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 '()))
(match rows
(() (reverse evaluations))
@ -1575,7 +1582,8 @@ WHERE status = 0 GROUP BY Evaluations.specification;"))
(loop rest
(cons `((#:specification . ,specification)
(#:evaluation
. ,(string->number evaluation)))
. ,(and=> (string->number evaluation)
db-get-evaluation)))
evaluations)))))))
(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
(db-get-evaluations-absolute-summary
(map (lambda (e)
`((#:id . ,(assq-ref e #:evaluation))))
evals))))
`((#:id . ,(assq-ref
(assq-ref e #:evaluation)
#:id))))
evals))
;; Get all the latest evaluations, regardless of their
;; status.
(db-get-latest-evaluations #:status #f)))
'())))
(('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
"Invalid status")))
(define (specifications-table specs evaluations summaries)
(define (spec->latest-eval name)
(define (specifications-table specs evaluations summaries latest-evaluations)
(define (spec->latest-eval-ok name)
(find (lambda (s)
(string=? (assq-ref s #:specification) name))
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)
(find (lambda (s)
(eq? (assq-ref s #:evaluation)
(assq-ref eval #:evaluation)))
(assq-ref
(assq-ref eval #:evaluation)
#:id)))
summaries))
(define (summary->percentage summary)
@ -352,50 +360,60 @@ system whose names start with " (code "guile-") ":" (br)
(style "vertical-align: middle"))
,@(let* ((summary
(eval-summary
(spec->latest-eval
(spec->latest-eval-ok
(specification-name spec))))
(last-eval
(spec->latest-eval
(specification-name spec)))
(last-eval-status-ok?
(<= (assq-ref last-eval #:status)
(evaluation-status succeeded)))
(percentage
(and summary (summary->percentage summary)))
(style
(format #f "width: ~a%" percentage)))
(if summary
`((div
(@ (class "progress job-abs")
(title "Percentage succeeded"))
(div (@ (class "progress-bar")
(role "progressbar")
(style ,style)
(aria-valuemin "0")
(aria-valuemax "100"))
(strong
(span
(@ (class "text-dark"))
,percentage
"%"))))
" "
(div
(@ (class "job-rel d-none"))
(div
(@ (class "badge badge-success")
(title "Succeeded"))
,(assq-ref summary #:succeeded))
(div
(@ (class "badge badge-danger")
(title "Failed"))
,(assq-ref summary #:failed))
(div
(@ (class "badge badge-secondary")
(title "Scheduled"))
,(assq-ref summary #:scheduled))))
'())))
(cond
((and summary last-eval-status-ok?)
`((div
(@ (class "progress job-abs")
(title "Percentage succeeded"))
(div (@ (class "progress-bar")
(role "progressbar")
(style ,style)
(aria-valuemin "0")
(aria-valuemax "100"))
(strong
(span
(@ (class "text-dark"))
,percentage
"%"))))
" "
(div
(@ (class "job-rel d-none"))
(div
(@ (class "badge badge-success")
(title "Succeeded"))
,(assq-ref summary #:succeeded))
(div
(@ (class "badge badge-danger")
(title "Failed"))
,(assq-ref summary #:failed))
(div
(@ (class "badge badge-secondary")
(title "Scheduled"))
,(assq-ref summary #:scheduled)))))
((not last-eval-status-ok?)
`((center
,@(evaluation-badges last-eval #f))))
(else '()))))
(td
,@(let* ((name (specification-name spec))
(dashboard-name
(string-append "Dashboard " name))
(eval (and=> (spec->latest-eval name)
(eval (and=> (spec->latest-eval-ok name)
(cut assq-ref <> #:evaluation))))
(if eval
`((a (@ (href "/eval/" ,eval
`((a (@ (href "/eval/" ,(assq-ref eval #:id)
"/dashboard"))
(div
(@ (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
(match (db-get-latest-evaluations)
((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"
'(2 0 1 1)