me
/
guix
Archived
1
0
Fork 0
Code

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.
master
Ludovic Courtès 2021-05-26 23:06:13 +02:00
parent 82d8ab01f5
commit 5bcb4f8a58
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 39 additions and 45 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

70
guix/lint.scm
View File

@ -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)
(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)))))
;; 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?

14
guix/ui.scm
View File

@ -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'