Improve the failed comparison page
This commit is contained in:
Christopher Baines
parent
faa32234d8
commit
6c47212c4d
|
|
@ -1399,13 +1399,37 @@ GROUP BY 1, 2")
|
|||
(let ((result
|
||||
(exec-query
|
||||
conn
|
||||
(string-append
|
||||
"SELECT id, commit, source, git_repository_id "
|
||||
"FROM load_new_guix_revision_jobs WHERE commit = $1")
|
||||
"
|
||||
SELECT id,
|
||||
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))))
|
||||
(match result
|
||||
(() #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
|
||||
#:key (limit 8))
|
||||
|
|
|
|||
|
|
@ -149,33 +149,35 @@
|
|||
(define (render-compare mime-types
|
||||
query-parameters)
|
||||
(if (any-invalid-query-parameters? query-parameters)
|
||||
(case (most-appropriate-mime-type
|
||||
'(application/json text/html)
|
||||
mime-types)
|
||||
((application/json)
|
||||
(render-json
|
||||
'((error . "invalid query"))))
|
||||
(else
|
||||
(letpar& ((base-job
|
||||
(match (assq-ref query-parameters 'base_commit)
|
||||
(($ <invalid-query-parameter> value)
|
||||
(with-thread-postgresql-connection
|
||||
(lambda (conn)
|
||||
(select-job-for-commit conn value))))
|
||||
(_ #f)))
|
||||
(target-job
|
||||
(match (assq-ref query-parameters 'target_commit)
|
||||
(($ <invalid-query-parameter> value)
|
||||
(with-thread-postgresql-connection
|
||||
(lambda (conn)
|
||||
(select-job-for-commit conn value))))
|
||||
(_ #f))))
|
||||
(letpar& ((base-job
|
||||
(match (assq-ref query-parameters 'base_commit)
|
||||
(($ <invalid-query-parameter> value)
|
||||
(with-thread-postgresql-connection
|
||||
(lambda (conn)
|
||||
(select-job-for-commit conn value))))
|
||||
(_ #f)))
|
||||
(target-job
|
||||
(match (assq-ref query-parameters 'target_commit)
|
||||
(($ <invalid-query-parameter> value)
|
||||
(with-thread-postgresql-connection
|
||||
(lambda (conn)
|
||||
(select-job-for-commit conn value))))
|
||||
(_ #f))))
|
||||
(case (most-appropriate-mime-type
|
||||
'(application/json text/html)
|
||||
mime-types)
|
||||
((application/json)
|
||||
(peek target-job)
|
||||
(render-json
|
||||
`((error . "invalid query")
|
||||
(base_job . ,base-job)
|
||||
(target_job . ,target-job))))
|
||||
(else
|
||||
(render-html
|
||||
#:sxml (compare-invalid-parameters
|
||||
query-parameters
|
||||
base-job
|
||||
target-job)))))
|
||||
|
||||
(letpar& ((base-revision-id
|
||||
(with-thread-postgresql-connection
|
||||
(lambda (conn)
|
||||
|
|
|
|||
|
|
@ -1028,32 +1028,43 @@
|
|||
(define 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
|
||||
#:body
|
||||
`(,(header)
|
||||
(div (@ (class "container"))
|
||||
(h1 "Unknown commit")
|
||||
,(if (invalid-query-parameter? base-commit)
|
||||
(if base-job
|
||||
`(p "Revision "
|
||||
(a (@ (href
|
||||
,(string-append "/revision/"
|
||||
(invalid-query-parameter-value base-commit))))
|
||||
(strong (samp ,(invalid-query-parameter-value base-commit))))
|
||||
" is queued for processing.")
|
||||
`(p "No known revision with commit "
|
||||
(strong (samp ,(invalid-query-parameter-value base-commit)))
|
||||
"."))
|
||||
'())
|
||||
,(if (invalid-query-parameter? target-commit)
|
||||
(if target-job
|
||||
`(p "Revision "
|
||||
(a (@ (href
|
||||
,(string-append "/revision/"
|
||||
(invalid-query-parameter-value target-commit))))
|
||||
(strong (samp ,(invalid-query-parameter-value target-commit))))
|
||||
" is queued for processing.")
|
||||
`(p "No known revision with commit "
|
||||
(strong (samp ,(invalid-query-parameter-value target-commit)))
|
||||
"."))
|
||||
'())))))
|
||||
,(if (peek "BASE" base-job)
|
||||
`(p "Revision "
|
||||
(a (@ (href
|
||||
,(string-append
|
||||
"/revision/"
|
||||
(invalid-query-parameter-value base-commit))))
|
||||
(strong (samp ,(invalid-query-parameter-value
|
||||
base-commit))))
|
||||
,(description-for-state
|
||||
(assq-ref base-job 'state)))
|
||||
`(p "No known revision with commit "
|
||||
(strong (samp ,base-commit))
|
||||
"."))
|
||||
,(if target-job
|
||||
`(p "Revision "
|
||||
(a (@ (href
|
||||
,(string-append
|
||||
"/revision/"
|
||||
(invalid-query-parameter-value 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))
|
||||
"."))))))
|
||||
|
|
|
|||
Loading…
Reference in New Issue