diff options
author | Mathieu Othacehe <othacehe@gnu.org> | 2020-09-06 14:23:01 +0200 |
---|---|---|
committer | Mathieu Othacehe <othacehe@gnu.org> | 2020-09-06 14:23:01 +0200 |
commit | d9879583afee201cb9a2fec6d5fd3a491247d475 (patch) | |
tree | 6d0bfe2fef44e465cbb445bc2d85316bebae1f5e /src | |
parent | 154232bc767d002f69aa6bb1cdddfd108b98584b (diff) | |
download | cuirass-d9879583afee201cb9a2fec6d5fd3a491247d475.tar cuirass-d9879583afee201cb9a2fec6d5fd3a491247d475.tar.gz |
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.
Diffstat (limited to 'src')
-rw-r--r-- | src/cuirass/database.scm | 19 | ||||
-rw-r--r-- | src/cuirass/templates.scm | 21 |
2 files changed, 35 insertions, 5 deletions
diff --git a/src/cuirass/database.scm b/src/cuirass/database.scm index fb22bcd..caada6e 100644 --- a/src/cuirass/database.scm +++ b/src/cuirass/database.scm @@ -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))))))))) diff --git a/src/cuirass/templates.scm b/src/cuirass/templates.scm index 170cc84..f099a49 100644 --- a/src/cuirass/templates.scm +++ b/src/cuirass/templates.scm @@ -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") |