diff options
| -rw-r--r-- | guix-data-service/jobs/load-new-guix-revision.scm | 57 | ||||
| -rw-r--r-- | guix-data-service/web/controller.scm | 8 | ||||
| -rw-r--r-- | guix-data-service/web/view/html.scm | 73 |
3 files changed, 138 insertions, 0 deletions
diff --git a/guix-data-service/jobs/load-new-guix-revision.scm b/guix-data-service/jobs/load-new-guix-revision.scm index 569ff62..d256f95 100644 --- a/guix-data-service/jobs/load-new-guix-revision.scm +++ b/guix-data-service/jobs/load-new-guix-revision.scm @@ -36,6 +36,7 @@ process-load-new-guix-revision-job select-job-for-commit select-jobs-and-events + select-unprocessed-jobs-and-events select-jobs-and-events-for-commit record-job-event enqueue-load-new-guix-revision-job @@ -1041,6 +1042,62 @@ ORDER BY load_new_guix_revision_jobs.id DESC") (string=? log-exists? "t")))) (exec-query conn query))) +(define (select-unprocessed-jobs-and-events conn) + (define query + " +SELECT + load_new_guix_revision_jobs.id, + load_new_guix_revision_jobs.commit, + load_new_guix_revision_jobs.source, + load_new_guix_revision_jobs.git_repository_id, + load_new_guix_revision_jobs.created_at, + ( + SELECT JSON_AGG( + json_build_object('event', event, 'occurred_at', occurred_at) ORDER BY occurred_at ASC + ) + FROM load_new_guix_revision_job_events + WHERE job_id = load_new_guix_revision_jobs.id + ), + EXISTS ( + SELECT 1 FROM load_new_guix_revision_job_logs WHERE job_id = load_new_guix_revision_jobs.id + ) AS log_exists, + commit IN ( + SELECT commit FROM ( + SELECT DISTINCT ON (name) + name, git_branches.commit + FROM git_branches + WHERE + git_branches.git_repository_id = load_new_guix_revision_jobs.git_repository_id AND + git_branches.commit IS NOT NULL + ORDER BY name, datetime DESC + ) branches_and_latest_commits + ) AS latest_branch_commit +FROM load_new_guix_revision_jobs +WHERE + succeeded_at IS NULL AND + ( + SELECT COUNT(*) + FROM load_new_guix_revision_job_events + WHERE job_id = load_new_guix_revision_jobs.id AND event = 'retry' + ) >= ( + SELECT COUNT(*) + FROM load_new_guix_revision_job_events + WHERE job_id = load_new_guix_revision_jobs.id AND event = 'failure' + ) +ORDER BY latest_branch_commit DESC, id DESC") + + (map + (match-lambda + ((id commit source git-repository-id created-at + events-json log-exists? latest-branch-commit) + (list id commit source git-repository-id created-at + (if (string-null? events-json) + #() + (json-string->scm events-json)) + (string=? log-exists? "t") + (string=? latest-branch-commit "t")))) + (exec-query conn query))) + (define (select-jobs-and-events-for-commit conn commit) (define query " 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 |