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

Add a new page listing jobs

Browse source
This commit is contained in:
Christopher Baines 2019-06-17 11:21:58 +01:00
parent 9c18c90505
commit ed0745096a
3 changed files with 100 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -2,6 +2,7 @@
#:use-module (srfi srfi-1)
#:use-module (ice-9 match)
#:use-module (ice-9 hash-table)
#:use-module (json)
#:use-module (squee)
#:use-module (guix monads)
#:use-module (guix store)
@ -23,6 +24,7 @@
#:use-module (guix-data-service model derivation)
#:export (process-next-load-new-guix-revision-job
select-job-for-commit
select-jobs-and-events
enqueue-load-new-guix-revision-job
most-recent-n-load-new-guix-revision-jobs))
@ -459,6 +461,36 @@ RETURNING id;")
(list commit))))
result))
(define (select-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,
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
)
FROM load_new_guix_revision_jobs
ORDER BY load_new_guix_revision_jobs.id DESC")
(map
(match-lambda
((id commit source git-repository-id created-at succeeded-at
events-json)
(list id commit source git-repository-id created-at succeeded-at
(if (string-null? events-json)
#()
(json-string->scm events-json)))))
(exec-query conn query)))
(define (most-recent-n-load-new-guix-revision-jobs conn n)
(let ((result
(exec-query

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

@ -548,6 +548,11 @@
derivations))
#:extra-headers http-headers-for-unchanging-content)))))
(define (render-jobs mime-types conn)
(render-html
#:sxml (view-jobs
(select-jobs-and-events conn))))
(define (parse-commit conn)
(lambda (s)
(if (guix-commit-exists? conn s)
@ -831,5 +836,8 @@
base-revision-id
target-commit
target-revision-id)))))
((GET "jobs")
(render-jobs mime-types
conn))
((GET path ...)
(not-found (request-uri request)))))

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

@ -40,6 +40,7 @@
view-builds
view-derivation
view-store-item
view-jobs
compare
compare/derivations
compare/packages
@ -906,6 +907,65 @@
derivations
derivations-using-store-item-list)))))
(define (view-jobs jobs-and-events)
(layout
#:body
`(,(header)
(div
(@ (class "container"))
(div
(@ (class "row"))
(div
(@ (class "col-sm-12"))
(h1 "Jobs")))
(div
(@ (class "row"))
(div
(@ (class "col-sm-12"))
(table
(@ (class "table"))
(thead
(tr
(th "Commit")
(th "Source")
(th "Events")))
(tdata
,@(map (match-lambda
((id commit source git-repository-id created-at succeeded-at
events)
`(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)))
(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))))))))
jobs-and-events)))))))))
(define (view-derivation derivation derivation-inputs derivation-outputs
builds)
(layout