branch master updated: Display evaluation date and duration.

[Mathieu Othacehe]

This is an automated email from the git hooks/post-receive script.

mothacehe pushed a commit to branch master
in repository guix-cuirass.

The following commit(s) were added to refs/heads/master by this push:
     new d987958  Display evaluation date and duration.
d987958 is described below

commit d9879583afee201cb9a2fec6d5fd3a491247d475
Author: Mathieu Othacehe <othacehe@gnu.org>
AuthorDate: Sun Sep 6 14:23:01 2020 +0200

    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.
---
 src/cuirass/database.scm  | 19 ++++++++++++++-----
 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")