aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorMathieu Othacehe <othacehe@gnu.org>2020-09-06 14:23:01 +0200
committerMathieu Othacehe <othacehe@gnu.org>2020-09-06 14:23:01 +0200
commitd9879583afee201cb9a2fec6d5fd3a491247d475 (patch)
tree6d0bfe2fef44e465cbb445bc2d85316bebae1f5e /src
parent154232bc767d002f69aa6bb1cdddfd108b98584b (diff)
downloadcuirass-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.scm19
-rw-r--r--src/cuirass/templates.scm21
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")