aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorChristopher Baines <mail@cbaines.net>2023-10-16 10:28:05 +0100
committerChristopher Baines <mail@cbaines.net>2023-10-16 10:28:05 +0100
commit78b4a068e8f99a9f830f17c5b5d9a29d47c08ee3 (patch)
treed4daa9609696cc7a8668e4f1a7e386232d48155b
parentffbba8e7d6d92c71c320dd5a152b956f56559e77 (diff)
downloadqa-frontpage-78b4a068e8f99a9f830f17c5b5d9a29d47c08ee3.tar
qa-frontpage-78b4a068e8f99a9f830f17c5b5d9a29d47c08ee3.tar.gz
Use #:unwind-for-type to simplify some exception handling
-rw-r--r--guix-qa-frontpage/branch.scm75
1 files changed, 22 insertions, 53 deletions
diff --git a/guix-qa-frontpage/branch.scm b/guix-qa-frontpage/branch.scm
index 99f70a5..016d544 100644
--- a/guix-qa-frontpage/branch.scm
+++ b/guix-qa-frontpage/branch.scm
@@ -181,49 +181,26 @@
(target . ,branch-commit)))
(up-to-date-with-master?
- (with-exception-handler
- (lambda (exn)
- (if (guix-data-service-error? exn)
- (guix-data-service-error->sexp exn)
- (begin
- (simple-format
- (current-error-port)
- "exception checking if branch is up to date (~A): ~A\n"
- branch-name
- exn)
- `((exception . ,(simple-format #f "~A" exn))))))
+ (with-exception-handler guix-data-service-error->sexp
(lambda ()
- (with-throw-handler #t
- (lambda ()
- (let* ((master-revision
- (get-latest-processed-branch-revision "master"))
- (changes
- (length
- (compare-package-derivations
- (compare-package-derivations-url
- `((base . ,merge-base)
- (target . ,master-revision))
- ;; TODO: Maybe do something smarter here?
- #:systems '("x86_64-linux"))))))
- `((up-to-date? . ,(< changes 3000))
- (changes . ,changes)
- (master . ,master-revision))))
- (lambda _
- (backtrace))))
- #:unwind? #t))
+ (let* ((master-revision
+ (get-latest-processed-branch-revision "master"))
+ (changes
+ (length
+ (compare-package-derivations
+ (compare-package-derivations-url
+ `((base . ,merge-base)
+ (target . ,master-revision))
+ ;; TODO: Maybe do something smarter here?
+ #:systems '("x86_64-linux"))))))
+ `((up-to-date? . ,(< changes 3000))
+ (changes . ,changes)
+ (master . ,master-revision))))
+ #:unwind? #t
+ #:unwind-for-type &guix-data-service-error))
(derivation-changes-data
- (with-exception-handler
- (lambda (exn)
- (if (guix-data-service-error? exn)
- (guix-data-service-error->sexp exn)
- (begin
- (simple-format
- (current-error-port)
- "exception fetching branch derivation changes (~A): ~A\n"
- branch-name
- exn)
- `((exception . ,(simple-format #f "~A" exn))))))
+ (with-exception-handler guix-data-service-error->sexp
(lambda ()
(let ((data
(compare-package-derivations
@@ -238,25 +215,17 @@
%systems-to-submit-builds-for))
(lambda _
(backtrace)))))
- #:unwind? #t))
+ #:unwind? #t
+ #:unwind-for-type &guix-data-service-error))
(substitute-availability
- (with-exception-handler
- (lambda (exn)
- (if (guix-data-service-error? exn)
- (guix-data-service-error->sexp exn)
- (begin
- (simple-format
- (current-error-port)
- "exception fetching branch substitute availability (~A): ~A\n"
- branch-name
- exn)
- `((exception . ,(simple-format #f "~A" exn))))))
+ (with-exception-handler guix-data-service-error->sexp
(lambda ()
(package-substitute-availability
(package-substitute-availability-url
branch-commit)))
- #:unwind? #t))
+ #:unwind? #t
+ #:unwind-for-type &guix-data-service-error))
;; TODO: Only include systems for which derivations are changed by
;; this branch