@@ -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
@@ -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 ...)
@@ -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)
@@ -299,6 +301,11 @@ (define (module<? m1 m2)
(define %hint-color (color BOLD CYAN))
+(define (maybe-display-fix-hint obj)
+ (when (fix-hint? obj)
+ (display-hint (condition-fix-hint obj)))
+ obj)
+
(define* (display-hint message #:optional (port (current-error-port)))
"Display MESSAGE, a l10n message possibly containing Texinfo markup, to
PORT."
@@ -398,8 +405,7 @@ (define* (report-load-error file args #:optional frame)
(formatted-message-arguments obj)))
(else
(report-error (G_ "exception thrown: ~s~%") obj)))
- (when (fix-hint? obj)
- (display-hint (condition-fix-hint obj))))
+ (maybe-display-fix-hint obj))
((key args ...)
(report-error (G_ "failed to load '~a':~%") file)
(match args
@@ -796,13 +802,26 @@ (define (manifest-entry-output* entry)
(cons (invoke-error-program c)
(invoke-error-arguments c))))
+ ((warning? c)
+ (match c
+ ((? formatted-message? c)
+ (apply emit-formatted-warning
+ (formatted-message-string c)
+ (formatted-message-arguments c)))
+ (_
+ ;; Ignore warnings that we cannot display in a meaningful way
+ ;; to the user. As a developer, you may peek using:
+ ;; (emit-formatted-warning "~a" c)
+ (values)))
+ (maybe-display-fix-hint c)
+ (values))
+
((formatted-message? c)
(apply report-error
(and (error-location? c) (error-location c))
(gettext (formatted-message-string c) %gettext-domain)
(formatted-message-arguments c))
- (when (fix-hint? c)
- (display-hint (condition-fix-hint c)))
+ (maybe-display-fix-hint c)
(exit 1))
;; On Guile 3.0.0, exceptions such as 'unbound-variable' are
@@ -826,8 +845,7 @@ (define (manifest-entry-output* entry)
(report-error (and (error-location? c) (error-location c))
(G_ "~a~%")
(gettext (condition-message c) %gettext-domain))
- (when (fix-hint? c)
- (display-hint (condition-fix-hint c)))
+ (maybe-display-fix-hint c)
(exit 1)))
(thunk)))