summaryrefslogtreecommitdiff
path: root/guix/ui.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2018-05-04 15:05:05 +0200
committerLudovic Courtès <ludo@gnu.org>2018-05-04 15:07:08 +0200
commit2d2f98efb36db3f003d950a004806234962b4f4d (patch)
treeb033067c85c0951a1477dde6405c19d399dba3d1 /guix/ui.scm
parent7f2f6a2cb2c4205ec22c2ca80a9c3675b6d7a4ea (diff)
downloadgnu-guix-2d2f98efb36db3f003d950a004806234962b4f4d.tar
gnu-guix-2d2f98efb36db3f003d950a004806234962b4f4d.tar.gz
guix build: Nicely report unbound variables with hints.
* guix/ui.scm (print-unbound-variable-error): Add "error:" to the message. (report-unbound-variable-error): New procedure, with code formerly in 'report-load-error'. (report-load-error): Use it. (call-with-unbound-variable-handling): New procedure. (with-unbound-variable-handling): New macro. * guix/scripts/build.scm (options->derivations): Wrap body in 'with-unbound-variable-handling'. * tests/guix-build.sh (GUIX_PACKAGE_PATH): Add test.
Diffstat (limited to 'guix/ui.scm')
-rw-r--r--guix/ui.scm51
1 files changed, 40 insertions, 11 deletions
diff --git a/guix/ui.scm b/guix/ui.scm
index 223d2eb2a0..8d351607d8 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -76,6 +76,7 @@
show-manifest-transaction
call-with-error-handling
with-error-handling
+ with-unbound-variable-handling
leave-on-EPIPE
read/eval
read/eval-package-expression
@@ -158,7 +159,7 @@ messages."
((proc message (variable) _ ...)
;; We can always omit PROC because when it's useful (i.e., different from
;; "module-lookup"), it gets displayed before.
- (format port (G_ "~a: unbound variable") variable))
+ (format port (G_ "error: ~a: unbound variable") variable))
(_
(default-printer))))
@@ -309,6 +310,21 @@ PORT."
(- (terminal-columns) 5))))
(texi->plain-text message))))
+(define* (report-unbound-variable-error args #:key frame)
+ "Return the given unbound-variable error, where ARGS is the list of 'throw'
+arguments."
+ (match args
+ ((key . args)
+ (print-exception (current-error-port) frame key args)))
+ (match args
+ (('unbound-variable proc message (variable) _ ...)
+ (match (known-variable-definition variable)
+ (#f
+ (display-hint (G_ "Did you forget a @code{use-modules} form?")))
+ ((? module? module)
+ (display-hint (format #f (G_ "Did you forget @code{(use-modules ~a)}?")
+ (module-name module))))))))
+
(define* (report-load-error file args #:optional frame)
"Report the failure to load FILE, a user-provided Scheme file.
ARGS is the list of arguments received by the 'throw' handler."
@@ -329,16 +345,8 @@ ARGS is the list of arguments received by the 'throw' handler."
(let ((loc (source-properties->location properties)))
(format (current-error-port) (G_ "~a: error: ~a~%")
(location->string loc) message)))
- (('unbound-variable proc message (variable) _ ...)
- (match args
- ((key . args)
- (print-exception (current-error-port) frame key args)))
- (match (known-variable-definition variable)
- (#f
- (display-hint (G_ "Did you forget a @code{use-modules} form?")))
- (module
- (display-hint (format #f (G_ "Did you forget @code{(use-modules ~a)}?")
- (module-name module))))))
+ (('unbound-variable _ ...)
+ (report-unbound-variable-error args #:frame frame))
(('srfi-34 obj)
(if (message-condition? obj)
(if (error-location? obj)
@@ -379,6 +387,27 @@ exiting. ARGS is the list of arguments received by the 'throw' handler."
(warning (G_ "failed to load '~a':~%") file)
(apply display-error #f (current-error-port) args))))
+(define (call-with-unbound-variable-handling thunk)
+ (define tag
+ (make-prompt-tag "user-code"))
+
+ (catch 'unbound-variable
+ (lambda ()
+ (call-with-prompt tag
+ thunk
+ (const #f)))
+ (const #t)
+ (rec (handle-error . args)
+ (let* ((stack (make-stack #t handle-error tag))
+ (frame (and stack (last-frame-with-source stack))))
+ (report-unbound-variable-error args #:frame frame)
+ (exit 1)))))
+
+(define-syntax-rule (with-unbound-variable-handling exp ...)
+ "Capture 'unbound-variable' exceptions in the dynamic extent of EXP... and
+report them in a user-friendly way."
+ (call-with-unbound-variable-handling (lambda () exp ...)))
+
(define (install-locale)
"Install the current locale settings."
(catch 'system-error