http: Move "/eval" page to (cuirass templates).

* src/cuirass/http.scm (url-handler): Move inline code for ('GET "eval" id)
to...
(evaluation-html-page): ... here.  New procedure.
* src/cuirass/templates.scm (evaluation-build-table): New procedure.

2 files changed, 128 insertions, 86 deletions

diff --git a/src/cuirass/http.scm b/src/cuirass/http.scm
index bf436c5..58bd6b6 100644
--- a/src/cuirass/http.scm
+++ b/src/cuirass/http.scm
@@ -1,7 +1,7 @@
 ;;;; http.scm -- HTTP API
 ;;; Copyright © 2016 Mathieu Lirzin <mthl@gnu.org>
 ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
-;;; Copyright © 2018, 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2018 Clément Lassieur <clement@lassieur.org>
 ;;; Copyright © 2018 Tatiana Sholokhova <tanja201396@gmail.com>
 ;;; Copyright © 2019 Ricardo Wurmus <rekado@elephly.net>
@@ -156,6 +156,46 @@ Hydra format."
 
 
 ;;;
+;;; HTML rendering.
+;;;
+
+(define* (evaluation-html-page evaluation
+                               #:key
+                               status
+                               border-high-time border-low-time
+                               border-high-id border-low-id)
+  "Return the HTML page representing EVALUATION."
+  (define id             (assq-ref evaluation #:id))
+  (define builds-id-max (db-get-builds-max id status))
+  (define builds-id-min (db-get-builds-min id status))
+  (define specification (db-get-evaluation-specification id))
+
+  (define builds
+    (vector->list
+     (handle-builds-request
+      `((evaluation . ,id)
+        (status . ,(and=> status string->symbol))
+        (nr . ,%page-size)
+        (order . finish-time+build-id)
+        (border-high-time . ,border-high-time)
+        (border-low-time . ,border-low-time)
+        (border-high-id . ,border-high-id)
+        (border-low-id . ,border-low-id)))))
+
+  (html-page
+   "Evaluation"
+   (evaluation-build-table evaluation
+                           #:status status
+                           #:builds builds
+                           #:builds-id-min builds-id-min
+                           #:builds-id-max builds-id-max)
+   `(((#:name . ,specification)
+      (#:link . ,(string-append "/jobset/" specification)))
+     ((#:name . ,(string-append "Evaluation " (number->string id)))
+      (#:link . ,(string-append "/eval/" (number->string id)))))))
+
+
+;;;
 ;;; Web server.
 ;;;
 ;;; The api is derived from the hydra one. It is partially described here :
@@ -409,8 +449,6 @@ Hydra format."
     (('GET "eval" id)
      (let* ((params (request-parameters request))
             (status (assq-ref params 'status))
-            (builds-id-max (db-get-builds-max id status))
-            (builds-id-min (db-get-builds-min id status))
             (border-high-time (assq-ref params 'border-high-time))
             (border-low-time (assq-ref params 'border-low-time))
             (border-high-id (assq-ref params 'border-high-id))
@@ -418,88 +456,16 @@ Hydra format."
             (specification (db-get-evaluation-specification id))
             (evaluation (db-get-evaluation-summary id)))
        (if specification
-           (let ((total     (assq-ref evaluation #:total))
-                 (succeeded (assq-ref evaluation #:succeeded))
-                 (failed    (assq-ref evaluation #:failed))
-                 (scheduled (assq-ref evaluation #:scheduled)))
-             (respond-html
-              (html-page
-               "Evaluation"
-               `((p (@ (class "lead"))
-                    ,(format #f "~@[~a~] ~:[B~;b~]uilds of evaluation #~a"
-                             (and=> status string-capitalize)
-                             status
-                             id))
-                 (ul (@ (class "nav nav-tabs"))
-                     (li (@ (class "nav-item"))
-                         (a (@ (class ,(string-append "nav-link "
-                                                      (match status
-                                                        (#f "active")
-                                                        (_ ""))))
-                               (href "?all="))
-                            "All "
-                            (span (@ (class "badge badge-light badge-pill"))
-                                  ,total)))
-                     (li (@ (class "nav-item"))
-                         (a (@ (class ,(string-append "nav-link "
-                                                      (match status
-                                                        ("pending" "active")
-                                                        (_ ""))))
-                               (href "?status=pending"))
-                            (span (@ (class "oi oi-clock text-warning")
-                                     (title "Scheduled")
-                                     (aria-hidden "true"))
-                                  "")
-                            " Scheduled "
-                            (span (@ (class "badge badge-light badge-pill"))
-                                  ,scheduled)))
-                     (li (@ (class "nav-item"))
-                         (a (@ (class ,(string-append "nav-link "
-                                                      (match status
-                                                        ("succeeded" "active")
-                                                        (_ ""))))
-                               (href "?status=succeeded"))
-                            (span (@ (class "oi oi-check text-success")
-                                     (title "Succeeded")
-                                     (aria-hidden "true"))
-                                  "")
-                            " Succeeded "
-                            (span (@ (class "badge badge-light badge-pill"))
-                                  ,succeeded)))
-                     (li (@ (class "nav-item"))
-                         (a (@ (class ,(string-append "nav-link "
-                                                      (match status
-                                                        ("failed" "active")
-                                                        (_ ""))))
-                               (href "?status=failed"))
-                            (span (@ (class "oi oi-x text-danger")
-                                     (title "Failed")
-                                     (aria-hidden "true"))
-                                  "")
-                            " Failed "
-                            (span (@ (class "badge badge-light badge-pill"))
-                                  ,failed))))
-                 (div (@ (class "tab-content pt-3"))
-                      (div (@ (class "tab-pane show active"))
-                           ,(build-eval-table
-                             id
-                             (vector->list
-                              (handle-builds-request
-                               `((evaluation . ,id)
-                                 (status . ,(and=> status string->symbol))
-                                 (nr . ,%page-size)
-                                 (order . finish-time+build-id)
-                                 (border-high-time . ,border-high-time)
-                                 (border-low-time . ,border-low-time)
-                                 (border-high-id . ,border-high-id)
-                                 (border-low-id . ,border-low-id))))
-                             builds-id-min
-                             builds-id-max
-                             status))))
-               `(((#:name . ,specification)
-                  (#:link . ,(string-append "/jobset/" specification)))
-                 ((#:name . ,(string-append "Evaluation " id))
-                  (#:link . ,(string-append "/eval/" id)))))))
+           (respond-html (evaluation-html-page evaluation
+                                               #:status status
+                                               #:border-high-time
+                                               border-high-time
+                                               #:border-low-time
+                                               border-low-time
+                                               #:border-high-id
+                                               border-high-id
+                                               #:border-low-id
+                                               border-low-id))
            (respond-html-eval-not-found id))))
 
     (('GET "eval" (= string->number id) "log" "raw")
diff --git a/src/cuirass/templates.scm b/src/cuirass/templates.scm
index 3f7647d..916b250 100644
--- a/src/cuirass/templates.scm
+++ b/src/cuirass/templates.scm
@@ -33,7 +33,8 @@
             evaluation-info-table
             build-eval-table
             build-search-results-table
-            build-details))
+            build-details
+            evaluation-build-table))
 
 (define (navigation-items navigation)
   (match navigation
@@ -482,6 +483,81 @@ and BUILD-MAX are global minimal and maximal (stoptime, rowid) pairs."
              (1- (build-id build-min))
              status))))))
 
+(define* (evaluation-build-table evaluation
+                                 #:key
+                                 status builds
+                                 builds-id-min builds-id-max)
+  "Return HTML for an evaluation page, containing a table of builds for that
+evaluation."
+  (define id        (assq-ref evaluation #:id))
+  (define total     (assq-ref evaluation #:total))
+  (define succeeded (assq-ref evaluation #:succeeded))
+  (define failed    (assq-ref evaluation #:failed))
+  (define scheduled (assq-ref evaluation #:scheduled))
+
+  `((p (@ (class "lead"))
+       ,(format #f "~@[~a~] ~:[B~;b~]uilds of evaluation #~a"
+                (and=> status string-capitalize)
+                status
+                id))
+    (ul (@ (class "nav nav-tabs"))
+        (li (@ (class "nav-item"))
+            (a (@ (class ,(string-append "nav-link "
+                                         (match status
+                                           (#f "active")
+                                           (_ ""))))
+                  (href "?all="))
+               "All "
+               (span (@ (class "badge badge-light badge-pill"))
+                     ,total)))
+        (li (@ (class "nav-item"))
+            (a (@ (class ,(string-append "nav-link "
+                                         (match status
+                                           ("pending" "active")
+                                           (_ ""))))
+                  (href "?status=pending"))
+               (span (@ (class "oi oi-clock text-warning")
+                        (title "Scheduled")
+                        (aria-hidden "true"))
+                     "")
+               " Scheduled "
+               (span (@ (class "badge badge-light badge-pill"))
+                     ,scheduled)))
+        (li (@ (class "nav-item"))
+            (a (@ (class ,(string-append "nav-link "
+                                         (match status
+                                           ("succeeded" "active")
+                                           (_ ""))))
+                  (href "?status=succeeded"))
+               (span (@ (class "oi oi-check text-success")
+                        (title "Succeeded")
+                        (aria-hidden "true"))
+                     "")
+               " Succeeded "
+               (span (@ (class "badge badge-light badge-pill"))
+                     ,succeeded)))
+        (li (@ (class "nav-item"))
+            (a (@ (class ,(string-append "nav-link "
+                                         (match status
+                                           ("failed" "active")
+                                           (_ ""))))
+                  (href "?status=failed"))
+               (span (@ (class "oi oi-x text-danger")
+                        (title "Failed")
+                        (aria-hidden "true"))
+                     "")
+               " Failed "
+               (span (@ (class "badge badge-light badge-pill"))
+                     ,failed))))
+    (div (@ (class "tab-content pt-3"))
+         (div (@ (class "tab-pane show active"))
+              ,(build-eval-table
+                id
+                builds
+                builds-id-min
+                builds-id-max
+                status)))))
+
 (define (build-search-results-table query builds build-min build-max)
   "Return HTML for the BUILDS table evaluation matching QUERY.  BUILD-MIN
 and BUILD-MAX are global minimal and maximal row identifiers."