[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
02/02: Improve the failed comparison page
|
From: |
Christopher Baines |
|
Subject: |
02/02: Improve the failed comparison page |
|
Date: |
Fri, 23 Oct 2020 11:25:52 -0400 (EDT) |
cbaines pushed a commit to branch master
in repository data-service.
commit 6c47212c4d82753bed50aa013924aac34926d7cc
Author: Christopher Baines <mail@cbaines.net>
AuthorDate: Fri Oct 23 16:23:16 2020 +0100
Improve the failed comparison page
---
guix-data-service/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)
- (($ <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)
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))
+ "."))))))