diff options
-rw-r--r-- | guix-qa-frontpage/branch.scm | 75 |
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 |