Display evaluation date and duration.

src/cuirass/database.scm (db-get-evaluations): Add support for "timestamp",
"checkouttime" and "evaltime" fields,
(db-get-evaluation-summary): ditto.
src/cuirass/templates.scm (nearest-exact-integer, seconds->string): New
procedures,
(evaluation-build-table): print evaluation date and duration.
This commit is contained in:
Mathieu Othacehe 2020-09-06 14:23:01 +02:00
parent 154232bc76
commit d9879583af
No known key found for this signature in database
GPG Key ID: 8354763531769CA6
2 changed files with 35 additions and 5 deletions

View File

@ -984,17 +984,21 @@ WHERE evaluation =" eval-id ";"))
(define (db-get-evaluations limit)
(with-db-worker-thread db
(let loop ((rows (sqlite-exec db "SELECT id, specification, in_progress
(let loop ((rows (sqlite-exec db "SELECT id, specification, in_progress,
timestamp, checkouttime, evaltime
FROM Evaluations ORDER BY id DESC LIMIT " limit ";"))
(evaluations '()))
(match rows
(() (reverse evaluations))
((#(id specification in-progress)
((#(id specification in-progress timestamp checkouttime evaltime)
. rest)
(loop rest
(cons `((#:id . ,id)
(#:specification . ,specification)
(#:in-progress . ,in-progress)
(#:timestamp . ,timestamp)
(#:checkouttime . ,checkouttime)
(#:evaltime . ,evaltime)
(#:checkouts . ,(db-get-checkouts id)))
evaluations)))))))
@ -1049,9 +1053,10 @@ WHERE specification=" spec)))
(define (db-get-evaluation-summary id)
(with-db-worker-thread db
(let ((rows (sqlite-exec db "
SELECT E.id, E.in_progress, B.total, B.succeeded, B.failed, B.scheduled
SELECT E.id, E.in_progress, E.timestamp, E.checkouttime, E.evaltime,
B.total, B.succeeded, B.failed, B.scheduled
FROM
(SELECT id, in_progress
(SELECT id, in_progress, timestamp, checkouttime, evaltime
FROM Evaluations
WHERE (id=" id ")) E
LEFT JOIN
@ -1063,10 +1068,14 @@ ON B.evaluation=E.id
ORDER BY E.id ASC;")))
(and=> (expect-one-row rows)
(match-lambda
(#(id in-progress total succeeded failed scheduled)
(#(id in-progress timestamp checkouttime evaltime
total succeeded failed scheduled)
`((#:id . ,id)
(#:in-progress . ,in-progress)
(#:total . ,(or total 0))
(#:timestamp . ,timestamp)
(#:checkouttime . ,checkouttime)
(#:evaltime . ,evaltime)
(#:succeeded . ,(or succeeded 0))
(#:failed . ,(or failed 0))
(#:scheduled . ,(or scheduled 0)))))))))

View File

@ -587,6 +587,17 @@ and BUILD-MAX are global minimal and maximal (stoptime, rowid) pairs."
(#f commit)
((link) `(a (@ (href ,(link url commit))) ,commit)))))
(define (nearest-exact-integer x)
"Given a real number X, return the nearest exact integer, with ties going to
the nearest exact even integer."
(inexact->exact (round x)))
(define (seconds->string duration)
(if (< duration 60)
(format #f "~a second~:p" duration)
(format #f "~a minute~:p" (nearest-exact-integer
(/ duration 60)))))
(define* (evaluation-build-table evaluation
#:key
(checkouts '())
@ -598,12 +609,22 @@ evaluation."
(define id (assq-ref evaluation #:id))
(define total (assq-ref evaluation #:total))
(define succeeded (assq-ref evaluation #:succeeded))
(define timestamp (assq-ref evaluation #:timestamp))
(define evaltime (assq-ref evaluation #:evaltime))
(define failed (assq-ref evaluation #:failed))
(define scheduled (assq-ref evaluation #:scheduled))
(define spec (assq-ref evaluation #:spec))
(define duration (- evaltime timestamp))
`((p (@ (class "lead"))
,(format #f "Evaluation #~a" id))
,(if (= evaltime 0)
`(p ,(format #f "Evaluation started ~a."
(time->string timestamp)))
`(p ,(format #f "Evaluation completed ~a in ~a."
(time->string evaltime)
(seconds->string duration))))
(table (@ (class "table table-sm table-hover"))
(thead
(tr (th (@ (class "border-0") (scope "col")) "Input")