aboutsummaryrefslogtreecommitdiff
path: root/guix-data-service/web
diff options
context:
space:
mode:
authorChristopher Baines <mail@cbaines.net>2019-10-12 21:16:39 +0100
committerChristopher Baines <mail@cbaines.net>2019-10-12 21:16:39 +0100
commitaf1ffc2393a640c5517db12e79035d140738a529 (patch)
tree94e60cc2e9fae46b6ea603a5a41bc5425bb1d8ce /guix-data-service/web
parent2279f1e0136b48fb9b3cbc685af8d5d14d559e16 (diff)
downloaddata-service-af1ffc2393a640c5517db12e79035d140738a529.tar
data-service-af1ffc2393a640c5517db12e79035d140738a529.tar.gz
Add a page for queued jobs
Diffstat (limited to 'guix-data-service/web')
-rw-r--r--guix-data-service/web/controller.scm8
-rw-r--r--guix-data-service/web/view/html.scm73
2 files changed, 81 insertions, 0 deletions
diff --git a/guix-data-service/web/controller.scm b/guix-data-service/web/controller.scm
index b418b6b..cee34f1 100644
--- a/guix-data-service/web/controller.scm
+++ b/guix-data-service/web/controller.scm
@@ -731,6 +731,11 @@
#:sxml (view-jobs
(select-jobs-and-events conn))))
+(define (render-job-queue mime-types conn)
+ (render-html
+ #:sxml (view-job-queue
+ (select-unprocessed-jobs-and-events conn))))
+
(define (render-job mime-types conn job-id query-parameters)
(render-html
#:sxml (view-job
@@ -1132,6 +1137,9 @@
(('GET "jobs")
(render-jobs mime-types
conn))
+ (('GET "jobs" "queue")
+ (render-job-queue mime-types
+ conn))
(('GET "job" job-id)
(let ((parsed-query-parameters
(parse-query-parameters
diff --git a/guix-data-service/web/view/html.scm b/guix-data-service/web/view/html.scm
index e50b53a..d915a51 100644
--- a/guix-data-service/web/view/html.scm
+++ b/guix-data-service/web/view/html.scm
@@ -46,6 +46,7 @@
view-derivation
view-store-item
view-jobs
+ view-job-queue
view-job
compare
compare/derivations
@@ -1491,6 +1492,78 @@
'())))))
jobs-and-events)))))))))
+(define (view-job-queue jobs-and-events)
+ (layout
+ #:body
+ `(,(header)
+ (div
+ (@ (class "container"))
+ (div
+ (@ (class "row"))
+ (div
+ (@ (class "col-sm-12"))
+ (h1 "Queued jobs ("
+ ,(length jobs-and-events)
+ ")")))
+ (div
+ (@ (class "row"))
+ (div
+ (@ (class "col-sm-12"))
+ (table
+ (@ (class "table"))
+ (thead
+ (tr
+ (th "Commit")
+ (th "Source")
+ (th "Events")
+ (th "")))
+ (tdata
+ ,@(map (match-lambda
+ ((id commit source git-repository-id created-at
+ events log-exists? latest-branch-commit?)
+ `(tr
+ (@ (class
+ ,(let ((event-names
+ (map (lambda (event)
+ (assoc-ref event "event"))
+ (vector->list events))))
+ (cond
+ ((member "success" event-names)
+ "success")
+ ((member "failure" event-names)
+ "danger")
+ ((member "start" event-names)
+ "info")
+ (else
+ "")))))
+ (td (a (@ (href
+ ,(string-append
+ "/revision/" commit)))
+ (samp ,commit)
+ ,@(if latest-branch-commit?
+ '((br)
+ (span (@ (class "text-danger"))
+ "(latest branch commit)"))
+ '())))
+ (td ,source)
+ (td
+ (dl
+ (@ (class "dl-horizontal"))
+ ,@(map
+ (lambda (event)
+ `((dt ,(assoc-ref event "event"))
+ (dd ,(assoc-ref event "occurred_at"))))
+ (cons
+ `(("event" . "created")
+ ("occurred_at" . ,created-at))
+ (vector->list events)))))
+ (td
+ ,@(if log-exists?
+ `((a (@ (href ,(string-append "/job/" id)))
+ "View log"))
+ '())))))
+ jobs-and-events)))))))))
+
(define (view-job job-id query-parameters log)
(layout
#:body