diff options
author | Ludovic Courtès <ludo@gnu.org> | 2021-05-26 23:06:13 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2021-06-01 23:26:07 +0200 |
commit | 5bcb4f8a58ad316174768c167927c03be3272786 (patch) | |
tree | 45c63a5b2fec99a3aa811ff2584ad738fb6b465a | |
parent | 82d8ab01f5cb6d479e3b82c08067e2442ee7cad8 (diff) | |
download | guix-5bcb4f8a58ad316174768c167927c03be3272786.tar.gz guix-5bcb4f8a58ad316174768c167927c03be3272786.zip |
ui, lint: Simplify exception handling in Guile 3 style.
* guix/lint.scm (check-derivation)[try]: Remove "catch #t" wrapping.
* guix/ui.scm (call-with-error-handling): Remove "catch 'system-error"
and move 'system-error handling to the &exception-with-kind-and-args
clause.
-rw-r--r-- | guix/lint.scm | 72 | ||||
-rw-r--r-- | guix/ui.scm | 14 |
2 files changed, 40 insertions, 46 deletions
diff --git a/guix/lint.scm b/guix/lint.scm index 023a179ea6..41dd5d0633 100644 --- a/guix/lint.scm +++ b/guix/lint.scm @@ -1010,45 +1010,39 @@ descriptions maintained upstream." (define* (check-derivation package #:key store) "Emit a warning if we fail to compile PACKAGE to a derivation." (define (try store system) - (catch #t ;TODO: Remove 'catch' when Guile 2.x is no longer supported. - (lambda () - (guard (c ((store-protocol-error? c) - (make-warning package - (G_ "failed to create ~a derivation: ~a") - (list system - (store-protocol-error-message c)))) - ((exception-with-kind-and-args? c) - (make-warning package - (G_ "failed to create ~a derivation: ~s") - (list system - (cons (exception-kind c) - (exception-args c))))) - ((message-condition? c) - (make-warning package - (G_ "failed to create ~a derivation: ~a") - (list system - (condition-message c)))) - ((formatted-message? c) - (let ((str (apply format #f - (formatted-message-string c) - (formatted-message-arguments c)))) - (make-warning package - (G_ "failed to create ~a derivation: ~a") - (list system str))))) - (parameterize ((%graft? #f)) - (package-derivation store package system #:graft? #f) - - ;; If there's a replacement, make sure we can compute its - ;; derivation. - (match (package-replacement package) - (#f #t) - (replacement - (package-derivation store replacement system - #:graft? #f)))))) - (lambda args - (make-warning package - (G_ "failed to create ~a derivation: ~s") - (list system args))))) + (guard (c ((store-protocol-error? c) + (make-warning package + (G_ "failed to create ~a derivation: ~a") + (list system + (store-protocol-error-message c)))) + ((exception-with-kind-and-args? c) + (make-warning package + (G_ "failed to create ~a derivation: ~s") + (list system + (cons (exception-kind c) + (exception-args c))))) + ((message-condition? c) + (make-warning package + (G_ "failed to create ~a derivation: ~a") + (list system + (condition-message c)))) + ((formatted-message? c) + (let ((str (apply format #f + (formatted-message-string c) + (formatted-message-arguments c)))) + (make-warning package + (G_ "failed to create ~a derivation: ~a") + (list system str))))) + (parameterize ((%graft? #f)) + (package-derivation store package system #:graft? #f) + + ;; If there's a replacement, make sure we can compute its + ;; derivation. + (match (package-replacement package) + (#f #t) + (replacement + (package-derivation store replacement system + #:graft? #f)))))) (define (check-with-store store) (filter lint-warning? diff --git a/guix/ui.scm b/guix/ui.scm index 6b0155f563..d3e01f846d 100644 --- a/guix/ui.scm +++ b/guix/ui.scm @@ -812,7 +812,12 @@ directories:~{ ~a~}~%") ;; been unwound when we re-raise, since that would otherwise show ;; useless backtraces. (((exception-predicate &exception-with-kind-and-args) c) - (raise c)) + (if (eq? 'system-error (exception-kind c)) ;EPIPE & co. + (match (exception-args c) + ((proc format-string format-args . _) + (leave (G_ "~a: ~a~%") proc + (apply format #f format-string format-args)))) + (raise c))) ((message-condition? c) ;; Normally '&message' error conditions have an i18n'd message. @@ -822,12 +827,7 @@ directories:~{ ~a~}~%") (when (fix-hint? c) (display-hint (condition-fix-hint c))) (exit 1))) - ;; Catch EPIPE and the likes. - (catch 'system-error - thunk - (lambda (key proc format-string format-args . rest) - (leave (G_ "~a: ~a~%") proc - (apply format #f format-string format-args)))))) + (thunk))) (define-syntax-rule (leave-on-EPIPE exp ...) "Run EXP... in a context where EPIPE errors are caught and lead to 'exit' |