| Message ID | 20211221224029.2091-1-attila@lendvai.name |
|---|---|
| State | New |
| Headers | show |
| Series | [bug#52724] guix: Prepare the UI for continuable &warning exceptions. | expand |
| Context | Check | Description |
|---|---|---|
| cbaines/comparison | success | View comparision |
| cbaines/git branch | success | View Git branch |
| cbaines/applying patch | success | View Laminar job |
| cbaines/issue | success | View issue |
Hi, >+ (guard* (c ((warning? c) >+ (if (formatted-message? c) >+ (apply emit-formatted-warning >+ (formatted-message-string c) >+ (formatted-message-arguments c)) >+ (emit-formatted-warning "~a" c)) >+ '()) I think this is better placed right before the 'formatted-message?', instead of before the 'package-input-error?'. Or maybe inside the 'formatted-message?' clause? If you put it inside the 'formatted-message?' clause, you would get fix hint support for free. I don't think the empty list as return value is meaningful here, maybe return nothing at all instead (using (values))? Also, you can't meaningfully stringify a condition. E.g., (display (condition (make-warning) (make-who-condition 'foo))) #<&compound-exception components: (#<&warning> #<&origin origin: foo>)> I don't think "warning: #<& foo:(#<&bar &baz> ...)...>" messages are very useful, so I would simply not handle warning? conditions that aren't formatted-message?. E.g.,: (guard* (c [...] ((and (warning? c) (formatted-message? c)) do-things) [...]) [...]) The downside is that, whenever some code raises a &warning that isn't also a &formatted-message, (guix ui) needs to be adjusted to support it as well, but that's acceptable I think. Also, a test or two would be great (unfortunately call-with-error- handling appears to be untested ...). Greetings, Maxime.
diff --git a/guix/diagnostics.scm b/guix/diagnostics.scm index 337a73c1a2..8e13e5e30a 100644 --- a/guix/diagnostics.scm +++ b/guix/diagnostics.scm @@ -48,6 +48,7 @@ (define-module (guix diagnostics) formatted-message? formatted-message-string formatted-message-arguments + emit-formatted-warning &fix-hint fix-hint? @@ -163,6 +164,9 @@ (define-syntax-rule (leave args ...) (report-error args ...) (exit 1))) +(define* (emit-formatted-warning fmt . args) + (emit-diagnostic fmt args #:prefix (G_ "warning: ") #:colors %warning-color)) + (define* (emit-diagnostic fmt args #:key location (colors (color)) (prefix "")) "Report diagnostic message FMT with the given ARGS and the specified diff --git a/guix/store.scm b/guix/store.scm index a93e9596d9..a2b3b2f05a 100644 --- a/guix/store.scm +++ b/guix/store.scm @@ -34,6 +34,8 @@ (define-module (guix store) #:use-module (guix profiling) #:autoload (guix build syscalls) (terminal-columns) #:use-module (rnrs bytevectors) + #:use-module ((rnrs conditions) #:select (warning?)) + #:use-module ((rnrs exceptions) #:select (raise-continuable)) #:use-module (ice-9 binary-ports) #:use-module ((ice-9 control) #:select (let/ec)) #:use-module (ice-9 atomic) @@ -661,8 +663,9 @@ (define (thunk) (apply values results))))) (with-exception-handler (lambda (exception) - (close-connection store) - (raise-exception exception)) + (unless (warning? exception) + (close-connection store)) + (raise-continuable exception)) thunk))) (define-syntax-rule (with-store store exp ...) diff --git a/guix/ui.scm b/guix/ui.scm index bd999103ff..f492b838d2 100644 --- a/guix/ui.scm +++ b/guix/ui.scm @@ -69,6 +69,8 @@ (define-module (guix ui) #:use-module (srfi srfi-31) #:use-module (srfi srfi-34) #:use-module (srfi srfi-35) + #:use-module ((rnrs conditions) + #:select (warning?)) #:autoload (ice-9 ftw) (scandir) #:use-module (ice-9 match) #:use-module (ice-9 format) @@ -690,7 +692,14 @@ (define (port-filename* port) (and (not (port-closed? port)) (port-filename port))) - (guard* (c ((package-input-error? c) + (guard* (c ((warning? c) + (if (formatted-message? c) + (apply emit-formatted-warning + (formatted-message-string c) + (formatted-message-arguments c)) + (emit-formatted-warning "~a" c)) + '()) + ((package-input-error? c) (let* ((package (package-error-package c)) (input (package-error-invalid-input c)) (location (package-location package))