[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[no subject]
From: |
Mathieu Othacehe |
Date: |
Wed, 1 Dec 2021 06:57:49 -0500 (EST) |
branch: master
commit 2d76216af7143996c45811800388a476fe7a0f15
Author: Mathieu Othacehe <othacehe@gnu.org>
AuthorDate: Wed Dec 1 12:31:07 2021 +0100
Display failing specification in the main page.
* 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.
---
src/cuirass/database.scm | 20 +++++++----
src/cuirass/http.scm | 9 +++--
src/cuirass/templates.scm | 90 ++++++++++++++++++++++++++++-------------------
tests/database.scm | 8 ++++-
4 files changed, 82 insertions(+), 45 deletions(-)
diff --git a/src/cuirass/database.scm b/src/cuirass/database.scm
index d47b709..efec012 100644
--- a/src/cuirass/database.scm
+++ b/src/cuirass/database.scm
@@ -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."
- (with-db-worker-thread db
- (let loop ((rows (exec-query db "
+(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 (if status
+ (exec-query/bind db "
+SELECT specification, max(id) FROM Evaluations
+WHERE status = " status " GROUP BY Evaluations.specification;")
+ (exec-query/bind db "
SELECT specification, max(id) FROM Evaluations
-WHERE status = 0 GROUP BY Evaluations.specification;"))
+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)
diff --git a/src/cuirass/http.scm b/src/cuirass/http.scm
index c8c6994..251498d 100644
--- a/src/cuirass/http.scm
+++ b/src/cuirass/http.scm
@@ -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)))
diff --git a/src/cuirass/templates.scm b/src/cuirass/templates.scm
index a272bce..a26c190 100644
--- a/src/cuirass/templates.scm
+++ b/src/cuirass/templates.scm
@@ -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")
diff --git a/tests/database.scm b/tests/database.scm
index 7458070..c7093bf 100644
--- a/tests/database.scm
+++ b/tests/database.scm
@@ -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)