[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[no subject]
|
From: |
Mathieu Othacehe |
|
Date: |
Wed, 1 Dec 2021 06:39:13 -0500 (EST) |
branch: wip-logs
commit c22c62bf9f2de083970cb1106744a269ed66a478
Author: Mathieu Othacehe <othacehe@gnu.org>
AuthorDate: Wed Dec 1 12:31:07 2021 +0100
wip: display failing specifications.
---
src/cuirass/database.scm | 20 ++++++++----
src/cuirass/http.scm | 9 ++++--
src/cuirass/templates.scm | 82 +++++++++++++++++++++++++++--------------------
tests/database.scm | 8 ++++-
4 files changed, 76 insertions(+), 43 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..9cc5e73 100644
--- a/src/cuirass/templates.scm
+++ b/src/cuirass/templates.scm
@@ -252,12 +252,17 @@ 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)
+ (find (lambda (s)
+ (string=? (assq-ref s #:specification) name))
+ latest-evaluations))
+
(define (eval-summary eval)
(find (lambda (s)
(eq? (assq-ref s #:evaluation)
@@ -352,47 +357,56 @@ 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?)
+ (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
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)