From 6c47212c4d82753bed50aa013924aac34926d7cc Mon Sep 17 00:00:00 2001 From: Christopher Baines Date: Fri, 23 Oct 2020 16:23:16 +0100 Subject: [PATCH] Improve the failed comparison page --- .../jobs/load-new-guix-revision.scm | 32 ++++++++-- guix-data-service/web/compare/controller.scm | 46 ++++++++------- guix-data-service/web/compare/html.scm | 59 +++++++++++-------- 3 files changed, 87 insertions(+), 50 deletions(-) diff --git a/guix-data-service/jobs/load-new-guix-revision.scm b/guix-data-service/jobs/load-new-guix-revision.scm index c399763..596891b 100644 --- a/guix-data-service/jobs/load-new-guix-revision.scm +++ b/guix-data-service/jobs/load-new-guix-revision.scm @@ -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)) diff --git a/guix-data-service/web/compare/controller.scm b/guix-data-service/web/compare/controller.scm index 2a55d56..9db338d 100644 --- a/guix-data-service/web/compare/controller.scm +++ b/guix-data-service/web/compare/controller.scm @@ -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) - (($ value) - (with-thread-postgresql-connection - (lambda (conn) - (select-job-for-commit conn value)))) - (_ #f))) - (target-job - (match (assq-ref query-parameters 'target_commit) - (($ value) - (with-thread-postgresql-connection - (lambda (conn) - (select-job-for-commit conn value)))) - (_ #f)))) + (letpar& ((base-job + (match (assq-ref query-parameters 'base_commit) + (($ value) + (with-thread-postgresql-connection + (lambda (conn) + (select-job-for-commit conn value)))) + (_ #f))) + (target-job + (match (assq-ref query-parameters 'target_commit) + (($ 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) diff --git a/guix-data-service/web/compare/html.scm b/guix-data-service/web/compare/html.scm index ac88d07..97dce70 100644 --- a/guix-data-service/web/compare/html.scm +++ b/guix-data-service/web/compare/html.scm @@ -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)) + "."))))))