mirror of
git://git.savannah.gnu.org/guix/guix-cuirass.git
synced 2023-12-14 06:03:04 +01:00
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)
|
(define (db-get-evaluations limit)
|
||||||
(with-db-worker-thread db
|
(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 ";"))
|
FROM Evaluations ORDER BY id DESC LIMIT " limit ";"))
|
||||||
(evaluations '()))
|
(evaluations '()))
|
||||||
(match rows
|
(match rows
|
||||||
(() (reverse evaluations))
|
(() (reverse evaluations))
|
||||||
((#(id specification in-progress)
|
((#(id specification in-progress timestamp checkouttime evaltime)
|
||||||
. rest)
|
. rest)
|
||||||
(loop rest
|
(loop rest
|
||||||
(cons `((#:id . ,id)
|
(cons `((#:id . ,id)
|
||||||
(#:specification . ,specification)
|
(#:specification . ,specification)
|
||||||
(#:in-progress . ,in-progress)
|
(#:in-progress . ,in-progress)
|
||||||
|
(#:timestamp . ,timestamp)
|
||||||
|
(#:checkouttime . ,checkouttime)
|
||||||
|
(#:evaltime . ,evaltime)
|
||||||
(#:checkouts . ,(db-get-checkouts id)))
|
(#:checkouts . ,(db-get-checkouts id)))
|
||||||
evaluations)))))))
|
evaluations)))))))
|
||||||
|
|
||||||
|
@ -1049,9 +1053,10 @@ WHERE specification=" spec)))
|
||||||
(define (db-get-evaluation-summary id)
|
(define (db-get-evaluation-summary id)
|
||||||
(with-db-worker-thread db
|
(with-db-worker-thread db
|
||||||
(let ((rows (sqlite-exec 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
|
FROM
|
||||||
(SELECT id, in_progress
|
(SELECT id, in_progress, timestamp, checkouttime, evaltime
|
||||||
FROM Evaluations
|
FROM Evaluations
|
||||||
WHERE (id=" id ")) E
|
WHERE (id=" id ")) E
|
||||||
LEFT JOIN
|
LEFT JOIN
|
||||||
|
@ -1063,10 +1068,14 @@ ON B.evaluation=E.id
|
||||||
ORDER BY E.id ASC;")))
|
ORDER BY E.id ASC;")))
|
||||||
(and=> (expect-one-row rows)
|
(and=> (expect-one-row rows)
|
||||||
(match-lambda
|
(match-lambda
|
||||||
(#(id in-progress total succeeded failed scheduled)
|
(#(id in-progress timestamp checkouttime evaltime
|
||||||
|
total succeeded failed scheduled)
|
||||||
`((#:id . ,id)
|
`((#:id . ,id)
|
||||||
(#:in-progress . ,in-progress)
|
(#:in-progress . ,in-progress)
|
||||||
(#:total . ,(or total 0))
|
(#:total . ,(or total 0))
|
||||||
|
(#:timestamp . ,timestamp)
|
||||||
|
(#:checkouttime . ,checkouttime)
|
||||||
|
(#:evaltime . ,evaltime)
|
||||||
(#:succeeded . ,(or succeeded 0))
|
(#:succeeded . ,(or succeeded 0))
|
||||||
(#:failed . ,(or failed 0))
|
(#:failed . ,(or failed 0))
|
||||||
(#:scheduled . ,(or scheduled 0)))))))))
|
(#:scheduled . ,(or scheduled 0)))))))))
|
||||||
|
|
|
@ -587,6 +587,17 @@ and BUILD-MAX are global minimal and maximal (stoptime, rowid) pairs."
|
||||||
(#f commit)
|
(#f commit)
|
||||||
((link) `(a (@ (href ,(link url commit))) ,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
|
(define* (evaluation-build-table evaluation
|
||||||
#:key
|
#:key
|
||||||
(checkouts '())
|
(checkouts '())
|
||||||
|
@ -598,12 +609,22 @@ evaluation."
|
||||||
(define id (assq-ref evaluation #:id))
|
(define id (assq-ref evaluation #:id))
|
||||||
(define total (assq-ref evaluation #:total))
|
(define total (assq-ref evaluation #:total))
|
||||||
(define succeeded (assq-ref evaluation #:succeeded))
|
(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 failed (assq-ref evaluation #:failed))
|
||||||
(define scheduled (assq-ref evaluation #:scheduled))
|
(define scheduled (assq-ref evaluation #:scheduled))
|
||||||
(define spec (assq-ref evaluation #:spec))
|
(define spec (assq-ref evaluation #:spec))
|
||||||
|
|
||||||
|
(define duration (- evaltime timestamp))
|
||||||
|
|
||||||
`((p (@ (class "lead"))
|
`((p (@ (class "lead"))
|
||||||
,(format #f "Evaluation #~a" id))
|
,(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"))
|
(table (@ (class "table table-sm table-hover"))
|
||||||
(thead
|
(thead
|
||||||
(tr (th (@ (class "border-0") (scope "col")) "Input")
|
(tr (th (@ (class "border-0") (scope "col")) "Input")
|
||||||
|
|
Loading…
Reference in a new issue