aboutsummaryrefslogtreecommitdiff
path: root/guix-qa-frontpage
diff options
context:
space:
mode:
authorChristopher Baines <mail@cbaines.net>2023-06-17 19:11:21 +0100
committerChristopher Baines <mail@cbaines.net>2023-06-17 19:11:21 +0100
commit42f13367bc789813ab0963440d9b9f14488dff13 (patch)
tree619043256f6ca9ed94b23d25a06d58f922e0cd65 /guix-qa-frontpage
parentef6e0f83d899e2348c717a3fd6ecde2b0b435079 (diff)
downloadqa-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.scm34
-rw-r--r--guix-qa-frontpage/view/branch.scm58
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)))
'()))))))))))))