diff options
| -rw-r--r-- | guix-data-service/web/controller.scm | 3 | ||||
| -rw-r--r-- | guix-data-service/web/jobs/controller.scm | 25 | ||||
| -rw-r--r-- | guix-data-service/web/jobs/html.scm | 69 |
3 files changed, 95 insertions, 2 deletions
diff --git a/guix-data-service/web/controller.scm b/guix-data-service/web/controller.scm index f481cc2..1eb4f20 100644 --- a/guix-data-service/web/controller.scm +++ b/guix-data-service/web/controller.scm @@ -319,8 +319,7 @@ (delegate-to-with-secret-key-base build-server-controller)) (('GET "compare" _ ...) (delegate-to compare-controller)) (('GET "compare-by-datetime" _ ...) (delegate-to compare-controller)) - (('GET "jobs") (delegate-to jobs-controller)) - (('GET "jobs" "queue") (delegate-to jobs-controller)) + (('GET "jobs" _ ...) (delegate-to jobs-controller)) (('GET "job" job-id) (delegate-to jobs-controller)) (('GET _ ...) (delegate-to nar-controller)) ((method path ...) diff --git a/guix-data-service/web/jobs/controller.scm b/guix-data-service/web/jobs/controller.scm index 733fb35..a589204 100644 --- a/guix-data-service/web/jobs/controller.scm +++ b/guix-data-service/web/jobs/controller.scm @@ -43,6 +43,19 @@ (render-jobs mime-types conn parsed-query-parameters))) + (('GET "jobs" "events") + (let ((parsed-query-parameters + (guard-against-mutually-exclusive-query-parameters + (parse-query-parameters + request + `((limit_results ,parse-result-limit + #:no-default-when (all_results) + #:default 50) + (all_results ,parse-checkbox-value))) + '((limit_results all_results))))) + (render-job-events mime-types + conn + parsed-query-parameters))) (('GET "jobs" "queue") (render-job-queue mime-types conn)) @@ -75,6 +88,18 @@ (>= (length jobs) limit-results)))))) +(define (render-job-events mime-types conn query-parameters) + (let* ((limit-results + (assq-ref query-parameters 'limit_results)) + (recent-events (select-recent-job-events + conn + ;; TODO Ideally there wouldn't be a limit + #:limit (or limit-results 1000000)))) + (render-html + #:sxml (view-job-events + query-parameters + recent-events)))) + (define (render-job-queue mime-types conn) (render-html #:sxml (view-job-queue diff --git a/guix-data-service/web/jobs/html.scm b/guix-data-service/web/jobs/html.scm index 3467cbf..bf6b369 100644 --- a/guix-data-service/web/jobs/html.scm +++ b/guix-data-service/web/jobs/html.scm @@ -21,6 +21,7 @@ #:use-module (guix-data-service web html-utils) #:use-module (guix-data-service web view html) #:export (view-jobs + view-job-events view-job-queue view-job)) @@ -171,6 +172,74 @@ "Next page"))) '()))))))) +(define (view-job-events query-parameters + recent-events) + (layout + #:body + `(,(header) + (div + (@ (class "container")) + (div + (@ (class "row")) + (div + (@ (class "col-sm-12")) + (a (@ (href "/jobs")) + (h3 "Jobs")) + (h1 "Recent events"))) + (div + (@ (class "row")) + (div + (@ (class "col-sm-12")) + (div + (@ (class "well")) + (form + (@ (method "get") + (action "") + (style "padding-bottom: 0") + (class "form-horizontal")) + ,(form-horizontal-control + "Limit results" query-parameters + #:help-text "The maximum number of jobs to return.") + ,(form-horizontal-control + "All results" query-parameters + #:type "checkbox" + #:help-text "Return all results.") + (div (@ (class "form-group form-group-lg")) + (div (@ (class "col-sm-offset-2 col-sm-10")) + (button (@ (type "submit") + (class "btn btn-lg btn-primary")) + "Update results"))))))) + (div + (@ (class "row")) + (div + (@ (class "col-sm-12")) + (table + (@ (class "table")) + (thead + (tr + (th "Commit") + (th "Event") + (th "Occurred at"))) + (tbody + ,@(map + (match-lambda + ((id commit source git-repository-id event occurred-at) + `(tr + (td (a (@ (href + ,(string-append + "/revision/" commit))) + (samp ,commit))) + (td ,@(let ((classes '(("start" . "info") + ("success" . "success") + ("failure" . "danger")))) + (or (and=> (assoc-ref classes event) + (lambda (class) + `((@ (class ,class))))) + '())) + ,event) + (td ,occurred-at)))) + recent-events))))))))) + (define (view-job-queue jobs-and-events) (layout #:body |