[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[no subject]
|
From: |
Tatiana |
|
Date: |
Sat, 21 Jul 2018 09:19:49 -0400 (EDT) |
branch: web-interface
commit 417c7eff906ac211891d35557c31cafa213f5c17
Author: TSholokhova <address@hidden>
Date: Sat Jul 21 15:19:32 2018 +0200
Fix codestyle.
* src/cuirass/templates.scm: Fix codestyle.
* src/cuirass/database.scm: Fix codestyle.
* src/cuirass/http.scm: Fix codestyle.
* tests/database.scm: Fix test.
* Makefile.am: Add static files paths.
---
Makefile.am | 16 +++++
src/cuirass/database.scm | 151 +++++++++++++++++++++++-----------------------
src/cuirass/http.scm | 114 ++++++++++++++++------------------
src/cuirass/templates.scm | 106 +++++++++++---------------------
tests/database.scm | 2 +-
5 files changed, 179 insertions(+), 210 deletions(-)
diff --git a/Makefile.am b/Makefile.am
index 75848ef..ed38317 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -32,6 +32,10 @@ pkgmoduledir = $(guilesitedir)/$(PACKAGE)
pkgobjectdir = $(guileobjectdir)/$(PACKAGE)
webmoduledir = $(guilesitedir)/web/server
webobjectdir = $(guileobjectdir)/web/server
+staticdir = $(pkgdatadir)/static
+cssdir = $(staticdir)/css
+fontsdir = $(staticdir)/fonts
+imagesdir = $(staticdir)/images
dist_pkgmodule_DATA = \
src/cuirass/base.scm \
@@ -57,6 +61,18 @@ nodist_webobject_DATA = \
dist_pkgdata_DATA = src/schema.sql
+dist_css_DATA = \
+ src/static/css/bootstrap.css \
+ src/static/css/open-iconic-bootstrap.css
+dist_fonts_DATA = \
+ src/static/fonts/open-iconic.eot \
+ src/static/fonts/open-iconic.otf \
+ src/static/fonts/open-iconic.svg \
+ src/static/fonts/open-iconic.ttf \
+ src/static/fonts/open-iconic.woff
+dist_images_DATA = \
+ src/static/images/logo.png
+
TEST_EXTENSIONS = .scm .sh
AM_TESTS_ENVIRONMENT = \
env GUILE_AUTO_COMPILE='0' \
diff --git a/src/cuirass/database.scm b/src/cuirass/database.scm
index 37494da..dda808c 100644
--- a/src/cuirass/database.scm
+++ b/src/cuirass/database.scm
@@ -2,6 +2,7 @@
;;; Copyright © 2016, 2017 Mathieu Lirzin <address@hidden>
;;; Copyright © 2017 Mathieu Othacehe <address@hidden>
;;; Copyright © 2018 Ludovic Courtès <address@hidden>
+;;; Copyright © 2018 Tatiana Sholokhova <address@hidden>
;;;
;;; This file is part of Cuirass.
;;;
@@ -55,6 +56,7 @@
read-sql-file
read-quoted-string
sqlite-exec
+ assqx-ref
;; Parameters.
%package-database
%package-schema-file
@@ -382,21 +384,21 @@ log file for DRV."
(#:outputs . ,(db-get-outputs db id))
(#:branch . ,branch)))))
+;; XXX Change caller and remove
+(define (assqx-ref filters key)
+ (match filters
+ (()
+ #f)
+ (((xkey xvalue) rest ...)
+ (if (eq? key xkey)
+ xvalue
+ (assqx-ref rest key)))))
+
(define (db-get-builds db filters)
"Retrieve all builds in database DB which are matched by given FILTERS.
FILTERS is an assoc list which possible keys are 'project | 'jobset | 'job |
'system | 'nr | 'order | 'status | 'evaluation "
- ;; XXX Change caller and remove
- (define (assqx-ref filters key)
- (match filters
- (()
- #f)
- (((xkey xvalue) rest ...)
- (if (eq? key xkey)
- xvalue
- (assqx-ref rest key)))))
-
(define (format-output name path)
`(,name . ((#:path . ,path))))
@@ -454,12 +456,11 @@ Assumes that if group id stays the same the group headers
stay the same."
(let ((outputs (cons-output x-output-name x-output-path outputs)))
(collect-outputs repeated-builds-id repeated-row outputs rest)))
((#(x-builds-id x-output-name x-output-path other-cells ...) . rest)
- (cons (finish-group) ;finish current group
-
+ (cons (finish-group);finish current group
;; Start new group.
(let* ((outputs (cons-output x-output-name x-output-path '()))
(x-repeated-row (list->vector other-cells)))
- (collect-outputs x-builds-id x-repeated-row outputs rest))))))
+ (collect-outputs x-builds-id x-repeated-row outputs
rest))))))
(define (group-outputs rows)
(match rows
@@ -468,26 +469,23 @@ Assumes that if group id stays the same the group headers
stay the same."
(let ((x-repeated-row (list->vector other-cells)))
(collect-outputs x-builds-id x-repeated-row '() rows)))))
- (let* ((order (match (assq 'order filters)
- ;(('order 'build-id) "Builds.id ASC")
- ;(('order 'decreasing-build-id) "Builds.id DESC")
- ;(('order 'finish-time) "Builds.stoptime DESC")
- ;(('order 'start-time) "Builds.starttime DESC")
- ;(('order 'submission-time) "Builds.timestamp DESC")
- ;(('order 'status+submission-time)
- (('order 'build-id) "id ASC")
- (('order 'decreasing-build-id) "id DESC")
- (('order 'finish-time) "stoptime DESC")
- (('order 'start-time) "starttime DESC")
- (('order 'submission-time) "timestamp DESC")
- (('order 'status+submission-time)
- ;; With this order, builds in 'running' state (-1) appear
- ;; before those in 'scheduled' state (-2).
- ;"Builds.status DESC, Builds.timestamp DESC")
- ;(_ "Builds.id DESC")))
- "status DESC, timestamp DESC")
- (_ "id DESC")))
- (stmt-text (format #f "\
+ (let*
+ ((order
+ (match
+ (assq 'order filters)
+ (('order 'build-id) "id ASC")
+ (('order 'decreasing-build-id) "id DESC")
+ (('order 'finish-time) "stoptime DESC")
+ (('order 'start-time) "starttime DESC")
+ (('order 'submission-time) "timestamp DESC")
+ (('order 'status+submission-time)
+ ;; With this order, builds in 'running' state (-1) appear
+ ;; before those in 'scheduled' state (-2).
+ ;"Builds.status DESC, Builds.timestamp DESC")
+ ;(_ "Builds.id DESC")))
+ "status DESC, timestamp DESC")
+ (_ "id DESC")))
+ (stmt-text (format #f "\
SELECT *
FROM (
SELECT Builds.id, Outputs.name, Outputs.path, Builds.timestamp,
Builds.starttime, Builds.stoptime, Builds.log, Builds.status,
Builds.derivation,\
@@ -510,8 +508,9 @@ AND (:borderhigh IS NULL OR (:borderhigh > Builds.stoptime))
ORDER BY CASE WHEN :borderlow IS NULL THEN Builds.stoptime ELSE
-Builds.stoptime END DESC
LIMIT :nr)
ORDER BY ~a, id ASC;" order))
- (stmt (sqlite-prepare db stmt-text #:cache? #t)))
- (sqlite-bind-arguments stmt #:id (assqx-ref filters 'id)
+ (stmt (sqlite-prepare db stmt-text #:cache? #t)))
+ (sqlite-bind-arguments stmt
+ #:id (assqx-ref filters 'id)
#:project (assqx-ref filters 'project)
#:jobset (assqx-ref filters 'jobset)
#:job (assqx-ref filters 'job)
@@ -522,8 +521,8 @@ ORDER BY ~a, id ASC;" order))
#:borderlow (assqx-ref filters 'border-low)
#:borderhigh (assqx-ref filters 'border-high)
#:nr (match (assqx-ref filters 'nr)
- (#f -1)
- (x x)))
+ (#f -1)
+ (x x)))
(sqlite-reset stmt)
(group-outputs (sqlite-fold-right cons '() stmt))))
@@ -582,65 +581,65 @@ FROM Evaluations ORDER BY id DESC LIMIT " limit ";"))
evaluations))))))
(define (db-get-evaluations-build-summary db spec limit border-low border-high)
- (let loop ((rows (sqlite-exec db
-"SELECT E.id, E.revision, B.succeeded, B.failed, B.scheduled FROM
- (SELECT id, evaluation, SUM(status=0) as succeeded, SUM(status>0) as failed,
SUM(status<0) as scheduled
- FROM Builds
- GROUP BY evaluation) B
- JOIN
- (SELECT id, revision
- FROM Evaluations
- WHERE (specification=" spec ")\
- AND (" border-low "IS NULL OR (id >" border-low "))\
- AND (" border-high "IS NULL OR (id <" border-high "))\
- ORDER BY CASE WHEN " border-low "IS NULL THEN id ELSE -id END DESC
- LIMIT " limit ") E
-ON B.evaluation=E.id
+ (let loop
+ ((rows (sqlite-exec db
+"SELECT E.id, E.revision, B.succeeded, B.failed, B.scheduled FROM \
+(SELECT id, evaluation, SUM(status=0) as succeeded, SUM(status>0) as failed,
SUM(status<0) as scheduled \
+FROM Builds \
+GROUP BY evaluation) B \
+JOIN \
+(SELECT id, revision \
+FROM Evaluations \
+WHERE (specification=" spec ") \
+AND (" border-low "IS NULL OR (id >" border-low ")) \
+AND (" border-high "IS NULL OR (id <" border-high ")) \
+ORDER BY CASE WHEN " border-low "IS NULL THEN id ELSE -id END DESC \
+LIMIT " limit ") E \
+ON B.evaluation=E.id \
ORDER BY E.id ASC;"))
- (evaluations '()))
- (match rows
- (() evaluations)
- ((#(id revision succeeded failed scheduled)
- . rest)
- (loop rest
- (cons `((#:id . ,id)
- (#:revision . ,revision)
- (#:succeeded . ,succeeded)
- (#:failed . ,failed)
- (#:scheduled . ,scheduled))
- evaluations))))))
+ (evaluations '()))
+ (match rows
+ (() evaluations)
+ ((#(id revision succeeded failed scheduled) . rest)
+ (loop rest
+ (cons `((#:id . ,id)
+ (#:revision . ,revision)
+ (#:succeeded . ,succeeded)
+ (#:failed . ,failed)
+ (#:scheduled . ,scheduled))
+ evaluations))))))
(define (db-get-evaluations-count db spec)
- "Return the number of evaluations of the given specification SPEC"
+ "Return the number of evaluations of the given specification SPEC."
(let ((rows (sqlite-exec db
-"SELECT COUNT(id) FROM Evaluations
+"SELECT COUNT(id) FROM Evaluations \
WHERE specification=" spec)))
- (array-ref (list-ref rows 0) 0)))
+ (array-ref (list-ref rows 0) 0)))
(define (db-get-evaluations-id-max db spec)
- "Return the max id of evaluations of the given specification SPEC"
+ "Return the max id of evaluations of the given specification SPEC."
(let ((rows (sqlite-exec db
"SELECT MAX(id) FROM Evaluations
WHERE specification=" spec)))
- (array-ref (list-ref rows 0) 0)))
+ (array-ref (list-ref rows 0) 0)))
(define (db-get-evaluations-id-min db spec)
- "Return the min id of evaluations of the given specification SPEC"
+ "Return the min id of evaluations of the given specification SPEC."
(let ((rows (sqlite-exec db
"SELECT MIN(id) FROM Evaluations
WHERE specification=" spec)))
- (array-ref (list-ref rows 0) 0)))
-
+ (array-ref (list-ref rows 0) 0)))
(define (db-get-builds-id-max db eval)
+ "Return the min id of build of the given evaluation EVAL."
(let ((rows (sqlite-exec db
-"SELECT MAX(stoptime) FROM Builds
+"SELECT MAX(stoptime) FROM Builds \
WHERE evaluation=" eval)))
- (array-ref (list-ref rows 0) 0)))
-
+ (array-ref (list-ref rows 0) 0)))
(define (db-get-builds-id-min db eval)
+ "Return the max id of build of the given evaluation EVAL."
(let ((rows (sqlite-exec db
-"SELECT MIN(stoptime) FROM Builds
+"SELECT MIN(stoptime) FROM Builds \
WHERE evaluation=" eval)))
- (array-ref (list-ref rows 0) 0)))
+ (array-ref (list-ref rows 0) 0)))
diff --git a/src/cuirass/http.scm b/src/cuirass/http.scm
index be21b3d..dcf1641 100644
--- a/src/cuirass/http.scm
+++ b/src/cuirass/http.scm
@@ -38,13 +38,16 @@
#:use-module (fibers channels)
#:use-module (sxml simple)
#:use-module (cuirass templates)
+ #:use-module (guix utils)
+ #:use-module (guix build union)
#:export (run-cuirass-server))
(define %static-directory
;; Define to the static file directory.
- (string-append (or (getenv "CUIRASS_DATADIR")
- (string-append %datadir "/" %package))
- "/static"))
+ (make-parameter (string-append
+ (or (getenv "CUIRASS_DATADIR")
+ (string-append %datadir "/" %package))
+ "/static")))
(define file-mime-types
'(("css" . (text/css))
@@ -62,34 +65,23 @@
"fonts/open-iconic.woff"
"images/logo.png"))
-
-(define (file-extension file-name)
- (last (string-split file-name #\.)))
-
-(define (directory? filename)
- (string=? filename (dirname filename)))
-
(define (build->hydra-build build)
"Convert BUILD to an assoc list matching hydra API format."
(define (bool->int bool)
(if bool 1 0))
-
(define finished?
(not (memv (assq-ref build #:status)
(list (build-status scheduled)
(build-status started)))))
-
`((#:id . ,(assq-ref build #:id))
(#:project . ,(assq-ref build #:repo-name))
(#:jobset . ,(assq-ref build #:branch))
(#:job . ,(assq-ref build #:job-name))
-
;; Hydra's API uses "timestamp" as the time of the last useful event for
;; that build: evaluation or completion.
(#:timestamp . ,(if finished?
(assq-ref build #:stoptime)
(assq-ref build #:timestamp)))
-
(#:starttime . ,(assq-ref build #:starttime))
(#:stoptime . ,(assq-ref build #:stoptime))
(#:derivation . ,(assq-ref build #:derivation))
@@ -106,15 +98,15 @@
(#:buildinputs_builds . #nil)))
(define (handle-build-request db-channel build-id)
- "Retrieve build identified by BUILD-ID over DB-CHANNEL and convert it to
-hydra format. Return #f is not build was found."
+ "Retrieve build identified by BUILD-ID over DB-CHANNEL and convert it
+ to hydra format. Return #f is not build was found."
(let ((build (with-critical-section db-channel (db)
(db-get-build db build-id))))
(and=> build build->hydra-build)))
(define (handle-builds-request db-channel filters)
- "Retrieve all builds matched by FILTERS in DB-CHANNEL and convert them to
-Hydra format."
+ "Retrieve all builds matched by FILTERS in DB-CHANNEL and convert them
+ to Hydra format."
(let ((builds (with-critical-section db-channel (db)
(with-time-logging "builds request"
(db-get-builds db filters)))))
@@ -139,7 +131,6 @@ Hydra format."
(string-split query #\&))
'())))
-
;;;
;;; Web server.
;;;
@@ -148,7 +139,6 @@ Hydra format."
;;; https://github.com/NixOS/hydra/blob/master/doc/manual/api.xml
;;;
-
(define (request-path-components request)
(split-and-decode-uri-path (uri-path (request-uri request))))
@@ -187,12 +177,15 @@ Hydra format."
(define (respond-static-file path)
;; PATH is a list of path components
(let ((file-name (string-join path "/"))
- (file-path (string-join (cons* %static-directory path) "/")))
+ (file-path
+ (string-join (cons* (%static-directory) path) "/")))
(if (and (member file-name file-white-list)
(file-exists? file-path)
- (not (directory? file-path)))
+ (not (file-is-directory? file-path)))
(respond
- `((content-type . ,(assoc-ref file-mime-types (file-extension
file-path))))
+ `((content-type . ,(assoc-ref
+ file-mime-types
+ (file-extension file-path))))
#:body (call-with-input-file file-path get-bytevector-all))
(respond-not-found file-name))))
@@ -224,8 +217,9 @@ Hydra format."
(with-critical-section db-channel (db)
(db-get-specifications db)))))
(("build" build-id)
- (let ((hydra-build (handle-build-request db-channel
- (string->number build-id))))
+ (let ((hydra-build (handle-build-request
+ db-channel
+ (string->number build-id))))
(if hydra-build
(respond-json (object->json-string hydra-build))
(respond-build-not-found build-id))))
@@ -269,10 +263,11 @@ Hydra format."
(if valid-params?
;; Limit results to builds that are "done".
(respond-json (object->json-string
- (handle-builds-request db-channel
- `((status done)
- ,@params
- (order finish-time)))))
+ (handle-builds-request
+ db-channel
+ `((status done)
+ ,@params
+ (order finish-time)))))
(respond-json-with-error 500 "Parameter not defined!"))))
(("api" "queue")
(let* ((params (request-parameters request))
@@ -292,28 +287,22 @@ Hydra format."
(respond-html (html-page
"Cuirass"
(specifications-table
- (with-critical-section db-channel (db)
(db-get-specifications db))))))
- (("status" name)
- (respond-html
- (html-page
- name
- (build-table
- (handle-builds-request db-channel
- `((status done)
- (project ,name)
- (nr 10)
- (order finish-time)))
- (handle-builds-request db-channel
- `((status pending)
- (project ,name)
- (nr 10)
- (order status+submission-time)))))))
+ (with-critical-section
+ db-channel
+ (db)
+ (db-get-specifications db))))))
+
(("jobset" name)
- (let* ((evaluation-id-max (with-critical-section db-channel (db)
(db-get-evaluations-id-max db name)))
- (evaluation-id-min (with-critical-section db-channel (db)
(db-get-evaluations-id-min db name)))
- (params (request-parameters request))
- (border-high (normalize-parameter (assq-ref params 'border-high)))
- (border-low (normalize-parameter (assq-ref params 'border-low))))
+ (let*
+ ((evaluation-id-max
+ (with-critical-section db-channel (db)
+ (db-get-evaluations-id-max db name)))
+ (evaluation-id-min
+ (with-critical-section db-channel (db)
+ (db-get-evaluations-id-min db name)))
+ (params (request-parameters request))
+ (border-high (assqx-ref params 'border-high))
+ (border-low (assqx-ref params 'border-low)))
(respond-html
(html-page
name
@@ -323,26 +312,28 @@ Hydra format."
(db-get-evaluations-build-summary
db
name
- PAGESIZE
+ (%pagesize)
border-low
- border-high
- ))
+ border-high))
evaluation-id-min
evaluation-id-max)))))
(("eval" id)
- (let* ((builds-id-max (with-critical-section db-channel (db)
(db-get-builds-id-max db id)))
- (builds-id-min (with-critical-section db-channel (db)
(db-get-builds-id-min db id)))
- (params (request-parameters request))
- (border-high (normalize-parameter (assq-ref params 'border-high)))
- (border-low (normalize-parameter (assq-ref params 'border-low))))
- (respond-html
- (html-page
+ (let*
+ ((builds-id-max (with-critical-section db-channel (db)
+ (db-get-builds-id-max db id)))
+ (builds-id-min (with-critical-section db-channel (db)
+ (db-get-builds-id-min db id)))
+ (params (request-parameters request))
+ (border-high (normalize-parameter (assq-ref params 'border-high)))
+ (border-low (normalize-parameter (assq-ref params 'border-low))))
+ (respond-html
+ (html-page
"Evaluations"
(build-eval-table
(handle-builds-request db-channel
`((evaluation ,id)
- (nr ,PAGESIZE)
+ (nr ,(%pagesize))
(order finish-time)
(border-high ,border-high)
(border-low ,border-low)))
@@ -350,7 +341,6 @@ Hydra format."
builds-id-max)))))
(("static" path ...)
- ;(display (request-uri request))
(respond-static-file path))
('method-not-allowed
;; 405 "Method Not Allowed"
diff --git a/src/cuirass/templates.scm b/src/cuirass/templates.scm
index 0e72981..d9f1e23 100644
--- a/src/cuirass/templates.scm
+++ b/src/cuirass/templates.scm
@@ -23,12 +23,14 @@
build-table
evaluation-info-table
build-eval-table
- PAGESIZE))
+ %pagesize))
-(define PAGESIZE 10)
+(define %pagesize
+ ;; description
+ (make-parameter 10))
(define (html-page title body)
- "Return html page with given title and body"
+ "Return HTML page with given TITLE and BODY."
`(html (@ (xmlns "http://www.w3.org/1999/xhtml";) (xml:lang "en") (lang "en"))
(head
(meta (@ (charset "utf-8")))
@@ -49,9 +51,8 @@
,body
(hr)))))
-
(define (specifications-table specs)
- "Return body for main (Projects) html-page"
+ "Return HTML for the SPECS table."
`((p (@ (class "lead")) "Projects")
(table
(@ (class "table table-sm table-hover"))
@@ -70,7 +71,7 @@
specs)))))))
(define (pagination page-id-min page-id-max id-min id-max)
- "Return page navigation buttons"
+ "Return page navigation buttons."
`(div (@ (class row))
(nav
(@ (class "mx-auto") (aria-label "Page navigation"))
@@ -90,31 +91,29 @@
(li (@ (class "page-item"))
(a (@ (class "page-link")
(href "?border-low=" ,(number->string (- id-min 1))))
- "Last >>"))
- ))))
-
-
-(define (minimum lst cur-min)
- (cond ((null? lst) cur-min)
- ((< (car lst) cur-min) (minimum (cdr lst) (car lst)))
- (else (minimum (cdr lst) cur-min))))
-
-
-(define (maximum lst cur-max)
- (cond ((null? lst) cur-max)
- ((> (car lst) cur-max) (maximum (cdr lst) (car lst)))
- (else (maximum (cdr lst) cur-max))))
-
-
-(define (evaluation-info-table name data evaluation-id-min evaluation-id-max)
- "Return body for (Evaluation) html-page"
- (let ((id-min (minimum (map (lambda (row) (assq-ref row #:id)) data)
evaluation-id-max))
- (id-max (maximum (map (lambda (row) (assq-ref row #:id)) data)
evaluation-id-min)))
+ "Last >>"))))))
+
+(define (minimum lst current-min)
+ "Return MINIMUM value in LST (list). Initial value is current-min."
+ (cond ((null? lst) current-min)
+ ((< (car lst) current-min) (minimum (cdr lst) (car lst)))
+ (else (minimum (cdr lst) current-min))))
+
+(define (maximum lst current-max)
+ "Return MAXIMUM value in LST (list). Initial value is current-max."
+ (cond ((null? lst) current-max)
+ ((> (car lst) current-max) (maximum (cdr lst) (car lst)))
+ (else (maximum (cdr lst) current-max))))
+
+(define (evaluation-info-table name evaluations evaluation-id-min
evaluation-id-max)
+ "Return HTML for the EVALUATION table NAME from EVALUATION-ID-MIN to
+ EVALUATION-ID-MAX."
+ (let ((id-min (minimum (map (lambda (row) (assq-ref row #:id)) evaluations)
evaluation-id-max))
+ (id-max (maximum (map (lambda (row) (assq-ref row #:id)) evaluations)
evaluation-id-min)))
`((p (@ (class "lead")) "Evaluations of " ,name)
- ;(p (@ (class "text-muted")) "Showing evaluations ",id-min "-",id-max "
out of ",evaluation-id-max)
(table
(@ (class "table table-sm table-hover table-striped"))
- ,@(if (null? data)
+ ,@(if (null? evaluations)
`((th (@ (scope "col")) "No elements here."))
`((thead
(tr
@@ -131,11 +130,12 @@
(a (@ (href "#") (class "badge badge-success"))
,(assq-ref row #:succeeded))
(a (@ (href "#") (class "badge badge-danger"))
,(assq-ref row #:failed))
(a (@ (href "#") (class "badge badge-secondary"))
,(assq-ref row #:scheduled)))))
- data)))))
+ evaluations)))))
,(pagination id-min id-max evaluation-id-min evaluation-id-max))))
-(define (build-eval-table data build-id-min build-id-max)
-
+(define (build-eval-table builds build-id-min build-id-max)
+ "Return HTML for the BUILDS table NAME from BUILD-ID-MIN to
+ BUILD-ID-MAX."
(define (table-header)
`(thead
(tr
@@ -159,49 +159,13 @@
(td ,(assq-ref build #:job))
(td ,(assq-ref build #:nixname))
(td ,(assq-ref build #:system))))
- (let ((id-min (minimum (map (lambda (row) (assq-ref row #:stoptime)) data)
build-id-max))
- (id-max (maximum (map (lambda (row) (assq-ref row #:stoptime)) data)
build-id-min)))
+ (let ((id-min (minimum (map (lambda (row) (assq-ref row #:stoptime)) builds)
build-id-max))
+ (id-max (maximum (map (lambda (row) (assq-ref row #:stoptime)) builds)
build-id-min)))
`((table
(@ (class "table table-sm table-hover table-striped"))
- ,@(if (null? data)
+ ,@(if (null? builds)
`((th (@ (scope "col")) "No elements here."))
`(,(table-header)
(tbody
- ,@(map table-row data)))))
+ ,@(map table-row builds)))))
,(pagination id-min id-max build-id-min build-id-max))))
-
-(define (build-table done pending)
- "Return body for project's html-page"
- (define (table-row build)
- `(tr
- (td ,(assq-ref build #:project))
- (td ,(assq-ref build #:jobset))
- (td ,(assq-ref build #:job))
- (td ,(assq-ref build #:nixname))
- (td ,(assq-ref build #:buildstatus))))
- (define (table-header)
- `(thead
- (tr
- (th (@ (scope "col")) Project)
- (th (@ (scope "col")) Jobset)
- (th (@ (scope "col")) Job)
- (th (@ (scope "col")) Nixname)
- (th (@ (scope "col")) Buildstatus))))
- `((table
- (@ (class "table table-sm table-hover table-striped"))
- (caption "Latest builds")
- ,@(if (null? done)
- `((th (@ (scope "col")) "No elements here."))
- `(,(table-header)
- (tbody
- (@ (class "table table-sm table-hover table-striped"))
- ,@(map table-row done)))))
- (table
- (@ (class "table table-sm table-hover table-striped"))
- (caption "Queue")
- ,@(if (null? pending)
- `((th (@ (scope "col")) "No elements here."))
- `(,(table-header)
- (tbody
- (@ (class "table table-sm table-hover table-striped"))
- ,@(map table-row pending)))))))
diff --git a/tests/database.scm b/tests/database.scm
index 847c8a6..a396299 100644
--- a/tests/database.scm
+++ b/tests/database.scm
@@ -157,7 +157,7 @@ INSERT INTO Evaluations (specification, revision) VALUES
(3, 3);")
((3 "/baz.drv") (2 "/bar.drv") (1 "/foo.drv")) ;descending order
((3 "/baz.drv") (2 "/bar.drv") (1 "/foo.drv")) ;ditto
((3 "/baz.drv") (2 "/bar.drv") (1 "/foo.drv")) ;ditto
- ((3 "/baz.drv")) ;nr = 1
+ ((1 "/foo.drv")) ;nr = 1
((2 "/bar.drv") (1 "/foo.drv") (3 "/baz.drv"))) ;status+submission-time
(with-temporary-database db
;; Populate the 'Builds', 'Derivations', 'Evaluations', and