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:
parent
154232bc76
commit
d9879583af
|
@ -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)))))))))
|
||||
|
|
|
@ -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")
|
||||
|
|
Loading…
Reference in New Issue