cbaines/guix-data-service
1
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Display the jobs related to a revision on the revision page

Browse source
This commit is contained in:
Christopher Baines 2019-07-22 20:00:11 +01:00
parent 1f1deac296
commit 91be72df03
3 changed files with 142 additions and 12 deletions
Download patch file Download diff file Expand all files Collapse all files

35
guix-data-service/jobs/load-new-guix-revision.scm
View file

@ -30,6 +30,7 @@
process-load-new-guix-revision-job
select-job-for-commit
select-jobs-and-events
select-jobs-and-events-for-commit
record-job-event
enqueue-load-new-guix-revision-job
most-recent-n-load-new-guix-revision-jobs))
@ -676,6 +677,40 @@ ORDER BY load_new_guix_revision_jobs.id DESC")
(string=? log-exists? "t"))))
(exec-query conn query)))
(define (select-jobs-and-events-for-commit conn commit)
(define query
"
SELECT
load_new_guix_revision_jobs.id,
load_new_guix_revision_jobs.source,
load_new_guix_revision_jobs.git_repository_id,
load_new_guix_revision_jobs.created_at,
load_new_guix_revision_jobs.succeeded_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
FROM load_new_guix_revision_jobs
WHERE commit = $1
ORDER BY load_new_guix_revision_jobs.id DESC")
(map
(match-lambda
((id source git-repository-id created-at succeeded-at
events-json log-exists?)
(list id commit source git-repository-id created-at succeeded-at
(if (string-null? events-json)
#()
(json-string->scm events-json))
(string=? log-exists? "t"))))
(exec-query conn query (list commit))))
(define (most-recent-n-load-new-guix-revision-jobs conn n)
(let ((result
(exec-query

9
guix-data-service/web/controller.scm
View file

@ -103,7 +103,9 @@
(git-repositories-and-branches
(git-branches-with-repository-details-for-commit conn commit-hash))
(derivations-counts
(count-packages-derivations-in-revision conn commit-hash)))
(count-packages-derivations-in-revision conn commit-hash))
(jobs-and-events
(select-jobs-and-events-for-commit conn commit-hash)))
(case (most-appropriate-mime-type
'(application/json text/html)
mime-types)
@ -125,6 +127,7 @@
packages-count
git-repositories-and-branches
derivations-counts
jobs-and-events
#:path-base path-base
#:header-text header-text)
#:extra-headers http-headers-for-unchanging-content)))))
@ -152,7 +155,9 @@
commit-hash
(select-job-for-commit
conn commit-hash)
(git-branches-with-repository-details-for-commit conn commit-hash))))))
(git-branches-with-repository-details-for-commit conn commit-hash)
(select-jobs-and-events-for-commit conn commit-hash))))))
(define* (render-revision-packages mime-types
conn

98
guix-data-service/web/view/html.scm
View file

@ -396,6 +396,7 @@
(define* (view-revision commit-hash packages-count
git-repositories-and-branches derivations-count
jobs-and-events
#:key (path-base "/revision/")
header-text)
(layout
@ -441,7 +442,51 @@
commit-hash)))
,name " at " ,datetime))))
branches))))
git-repositories-and-branches))))
git-repositories-and-branches)))
(h3 "Jobs")
(table
(@ (class "table"))
(thead
(tr
(th "Source")
(th "Events")
(th "")))
(tbody
,@(map (match-lambda
((id commit source git-repository-id created-at succeeded-at
events log-exists?)
`(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 ,source)
(td
(dl
,@(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))))
(div
(@ (class "col-md-6"))
(h3 "Derivations")
@ -1491,7 +1536,8 @@
(h1 ,header-text)
(p ,body)))))
(define (unknown-revision commit-hash job git-repositories-and-branches)
(define (unknown-revision commit-hash job git-repositories-and-branches
jobs-and-events)
(layout
#:body
`(,(header)
@ -1524,7 +1570,7 @@
`((h3 "Git repositories")
,@(map
(match-lambda
(((label url cgit-url-base) . branches)
(((id label url cgit-url-base) . branches)
`((h4 ,url)
,@(map
(match-lambda
@ -1537,7 +1583,51 @@
commit-hash)))
,name " at " ,datetime))))
branches))))
git-repositories-and-branches))))
git-repositories-and-branches)))
(h3 "Jobs")
(table
(@ (class "table"))
(thead
(tr
(th "Source")
(th "Events")
(th "")))
(tbody
,@(map (match-lambda
((id commit source git-repository-id created-at succeeded-at
events log-exists?)
`(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 ,source)
(td
(dl
,@(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))))
(div
(@ (class "col-md-6"))
(h3 "Derivations")