diff options
author | Christopher Baines <mail@cbaines.net> | 2023-06-17 19:11:21 +0100 |
---|---|---|
committer | Christopher Baines <mail@cbaines.net> | 2023-06-17 19:11:21 +0100 |
commit | 42f13367bc789813ab0963440d9b9f14488dff13 (patch) | |
tree | 619043256f6ca9ed94b23d25a06d58f922e0cd65 /guix-qa-frontpage | |
parent | ef6e0f83d899e2348c717a3fd6ecde2b0b435079 (diff) | |
download | qa-frontpage-42f13367bc789813ab0963440d9b9f14488dff13.tar qa-frontpage-42f13367bc789813ab0963440d9b9f14488dff13.tar.gz |
Fix displaying error information on the branch page
Diffstat (limited to 'guix-qa-frontpage')
-rw-r--r-- | guix-qa-frontpage/branch.scm | 34 | ||||
-rw-r--r-- | guix-qa-frontpage/view/branch.scm | 58 |
2 files changed, 49 insertions, 43 deletions
diff --git a/guix-qa-frontpage/branch.scm b/guix-qa-frontpage/branch.scm index 6b1008b..1d0182a 100644 --- a/guix-qa-frontpage/branch.scm +++ b/guix-qa-frontpage/branch.scm @@ -191,21 +191,25 @@ (match-lambda ((param . val) (and=> - (assoc-ref val "invalid") - (lambda (reason) - (cons - param - ;; Convert the HTML error messages to something - ;; easier to handle - (cond - ((string-contains reason - "failed to process revision") - 'failed-to-process-revision) - ((string-contains reason - "yet to process revision") - 'yet-to-process-revision) - (else - reason))))))) + (assoc-ref val "invalid_value") + (lambda (value) + (let ((message + (assoc-ref val "message"))) + (cons + param + `((value . ,value) + (error + ;; Convert the HTML error messages + ;; to something easier to handle + . ,(cond + ((string-contains message + "failed to process revision") + 'failed-to-process-revision) + ((string-contains message + "yet to process revision") + 'yet-to-process-revision) + (else + 'unknown)))))))))) (assoc-ref (guix-data-service-error-response-body exn) "query_parameters")))) diff --git a/guix-qa-frontpage/view/branch.scm b/guix-qa-frontpage/view/branch.scm index b2c8b65..6a00044 100644 --- a/guix-qa-frontpage/view/branch.scm +++ b/guix-qa-frontpage/view/branch.scm @@ -240,35 +240,37 @@ td.bad { (lambda (params) (append-map (match-lambda - ((param . error) - (cond - ((member param '("base_commit" - "target_commit")) - `((br) - (a - (@ (href - ,(string-append - "https://data.qa.guix.gnu.org" - "/revision/" - (assq-ref - revisions + ((param . details) + (let ((error + (assq-ref details 'error))) + (cond + ((member param '("base_commit" + "target_commit")) + `((br) + (a + (@ (href + ,(string-append + "https://data.qa.guix.gnu.org" + "/revision/" + (assq-ref + revisions + (if (string=? param "base_commit") + 'base + 'target))))) + ,(cond + ((member error + '(yet-to-process-revision + failed-to-process-revision)) + (simple-format + #f "~A to process ~A" + (if (eq? error 'yet-to-process-revision) + "Yet" + "Failed") (if (string=? param "base_commit") - 'base - 'target))))) - ,(cond - ((member error - '(yet-to-process-revision - failed-to-process-revision)) - (simple-format - #f "~A to process ~A" - (if (eq? error 'yet-to-process-revision) - "Yet" - "Failed") - (if (string=? param "base_commit") - "base revision (from master branch)" - (string-append - "target revision (from " - branch " branch)"))))))))))) + "base revision (from master branch)" + (string-append + "target revision (from " + branch " branch)")))))))))))) params))) '())))))))))))) |