Add a page for queued jobs
This commit is contained in:
Christopher Baines
parent
2279f1e013
commit
af1ffc2393
|
|
@ -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
|
||||
"
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Reference in New Issue