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

Improve the failed comparison page

Browse source
This commit is contained in:
Christopher Baines 2020-10-23 16:23:16 +01:00
parent faa32234d8
commit 6c47212c4d
3 changed files with 87 additions and 50 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

@ -1399,13 +1399,37 @@ GROUP BY 1, 2")
(let ((result (let ((result
(exec-query (exec-query
conn conn
(string-append "
"SELECT id, commit, source, git_repository_id " SELECT id,
"FROM load_new_guix_revision_jobs WHERE commit = $1") commit,
source,
git_repository_id,
CASE WHEN succeeded_at IS NOT NULL
THEN 'succeeded'
WHEN (
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'
)
THEN 'queued'
ELSE 'failed'
END AS state
FROM load_new_guix_revision_jobs WHERE commit = $1"
(list commit)))) (list commit))))
(match result (match result
(() #f) (() #f)
((job) job)))) (((id commit source git_repository_id state))
`((id . ,(string->number id))
(commit . ,commit)
(source . ,source)
(git_repository_id . ,(string->number git_repository_id))
(state . ,state))))))
(define* (select-recent-job-events conn (define* (select-recent-job-events conn
#:key (limit 8)) #:key (limit 8))

46
guix-data-service/web/compare/controller.scm
View file

@ -149,33 +149,35 @@
(define (render-compare mime-types (define (render-compare mime-types
query-parameters) query-parameters)
(if (any-invalid-query-parameters? query-parameters) (if (any-invalid-query-parameters? query-parameters)
(case (most-appropriate-mime-type (letpar& ((base-job
'(application/json text/html) (match (assq-ref query-parameters 'base_commit)
mime-types) (($ <invalid-query-parameter> value)
((application/json) (with-thread-postgresql-connection
(render-json (lambda (conn)
'((error . "invalid query")))) (select-job-for-commit conn value))))
(else (_ #f)))
(letpar& ((base-job (target-job
(match (assq-ref query-parameters 'base_commit) (match (assq-ref query-parameters 'target_commit)
(($ <invalid-query-parameter> value) (($ <invalid-query-parameter> value)
(with-thread-postgresql-connection (with-thread-postgresql-connection
(lambda (conn) (lambda (conn)
(select-job-for-commit conn value)))) (select-job-for-commit conn value))))
(_ #f))) (_ #f))))
(target-job (case (most-appropriate-mime-type
(match (assq-ref query-parameters 'target_commit) '(application/json text/html)
(($ <invalid-query-parameter> value) mime-types)
(with-thread-postgresql-connection ((application/json)
(lambda (conn) (peek target-job)
(select-job-for-commit conn value)))) (render-json
(_ #f)))) `((error . "invalid query")
(base_job . ,base-job)
(target_job . ,target-job))))
(else
(render-html (render-html
#:sxml (compare-invalid-parameters #:sxml (compare-invalid-parameters
query-parameters query-parameters
base-job base-job
target-job))))) target-job)))))
(letpar& ((base-revision-id (letpar& ((base-revision-id
(with-thread-postgresql-connection (with-thread-postgresql-connection
(lambda (conn) (lambda (conn)

59
guix-data-service/web/compare/html.scm
View file

@ -1028,32 +1028,43 @@
(define target-commit (define target-commit
(assq-ref query-parameters 'target_commit)) (assq-ref query-parameters 'target_commit))
(define (description-for-state state)
(cond
((string=? state "queued")
" is queued for processing.")
((string=? state "failed")
" has failed.")
((string=? state "succeeded")
" has succeeded.")))
(layout (layout
#:body #:body
`(,(header) `(,(header)
(div (@ (class "container")) (div (@ (class "container"))
(h1 "Unknown commit") (h1 "Unknown commit")
,(if (invalid-query-parameter? base-commit) ,(if (peek "BASE" base-job)
(if base-job `(p "Revision "
`(p "Revision " (a (@ (href
(a (@ (href ,(string-append
,(string-append "/revision/" "/revision/"
(invalid-query-parameter-value base-commit)))) (invalid-query-parameter-value base-commit))))
(strong (samp ,(invalid-query-parameter-value base-commit)))) (strong (samp ,(invalid-query-parameter-value
" is queued for processing.") base-commit))))
`(p "No known revision with commit " ,(description-for-state
(strong (samp ,(invalid-query-parameter-value base-commit))) (assq-ref base-job 'state)))
".")) `(p "No known revision with commit "
'()) (strong (samp ,base-commit))
,(if (invalid-query-parameter? target-commit) "."))
(if target-job ,(if target-job
`(p "Revision " `(p "Revision "
(a (@ (href (a (@ (href
,(string-append "/revision/" ,(string-append
(invalid-query-parameter-value target-commit)))) "/revision/"
(strong (samp ,(invalid-query-parameter-value target-commit)))) (invalid-query-parameter-value target-commit))))
" is queued for processing.") (strong (samp ,(invalid-query-parameter-value
`(p "No known revision with commit " target-commit))))
(strong (samp ,(invalid-query-parameter-value target-commit))) ,(description-for-state
".")) (assq-ref target-job 'state)))
'()))))) `(p "No known revision with commit "
(strong (samp ,target-commit))
"."))))))