Reporting module errors

[Ludovic Courtès]

Hello!

You’re too fast!  :-)

julien lepiller <address@hidden> skribis:

> +(define (import-error type module syntax)
> +  (define package-hint
> +    (string-append
> +      "Hint: You may use `guix package --show=foo | grep location` to 
> search\n"
> +      "Hint: for foo's location.\n"
> +      "Hint: If you get the line \"location: gnu/packages/bar.scm:174:2\",\n"
> +      "Hint: you want to add bar in use-package-modules."))
> +  (define service-hint
> +    (string-append
> +      "Hint: You may use `guix system search foo` to search for foo's 
> location.\n"
> +      "Hint: If you get the line \"location: gnu/services/bar.scm:188:2\",\n"
> +      "Hint: you want to add bar in use-service-modules."))
> +  (error (string-append
> +           type " module \"" module "\" does not exist.\n"
> +           "Check the \"" syntax "\" line in your configuration.\n"
> +           (if (equal? type "Package")
> +               package-hint
> +               (if (equal? type "Service")
> +                   service-hint
> +                   "")))))
> +
>  (define-syntax-rule (use-package-modules module ...)
> -  (use-modules (gnu packages module) ...))
> +  (begin
> +    (catch #t (lambda () (use-modules (gnu packages module)))
> +           (lambda _
> +             (import-error "Package" (symbol->string 'module) 
> "use-package-modules")))
> +    ...))

That’s a great suggestion!

I’d propose a variant of it, see below.  With this, one gets a message
like:

  /tmp/config.scm:6:0: module (gnu packages foobar) could not be found

where line 6 is:

  (use-package-modules foobar)

How does that sound?

It lacks the hints that you were proposing, which isn’t great, but I
think we’d need to provide a homogeneous and internationalized API in
(guix ui) if we are to display hints.  But overall I like the idea of
providing hints somehow.

Perhaps we could simply introduce another condition type for hints as a
first step, similar to ‘&message’?

Speaking of hints, we should have something that suggests a module name
based on the Levenshtein distance with available modules.  :-)

Thanks,
Ludo’.

diff --git a/gnu.scm b/gnu.scm
index 913ce6160..6dde968f1 100644
--- a/gnu.scm
+++ b/gnu.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014, 2015, 2016 Ludovic Courtès <address@hidden>
+;;; Copyright © 2014, 2015, 2016, 2017 Ludovic Courtès <address@hidden>
 ;;; Copyright © 2015 Joshua S. Grant <address@hidden>
 ;;; Copyright © 2017 Mathieu Othacehe <address@hidden>
 ;;;
@@ -19,6 +19,10 @@
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (gnu)
+  #:use-module (guix utils)
+  #:use-module (srfi srfi-34)
+  #:use-module (srfi srfi-35)
+  #:use-module (ice-9 match)
   #:export (use-package-modules
             use-service-modules
             use-system-modules))
@@ -52,13 +56,46 @@
                   (module-use! i (resolve-interface m))))
               %public-modules)))
 
+(define (%try-use-modules modules location)
+  "Attempt to load all of MODULES.  Report errors as coming from LOCATION, a
+source property alist."
+  (define (location->string loc)
+    (match loc
+      (#f "")
+      (($ <location> file line column)
+       (format #f "~a:~a:~a: " file line column))))
+
+  (for-each (lambda (module)
+              (catch 'misc-error
+                (lambda ()
+                  (process-use-modules `((,module))))
+                (lambda _
+                  (raise (condition
+                          (&message
+                           ;; TODO: Suggest a module with a similar name.
+                           (message
+                            (let-syntax ((G_ (syntax-rules ()
+                                               ((_ str) str))))
+                              (format #f
+                                      (G_ "module ~a could not be found~%")
+                                      module))))
+                          (&error-location
+                           (location location)))))))
+            modules))
+
+(define-syntax-rule (try-use-modules modules ...)
+  (eval-when (expand load eval)
+    (%try-use-modules '(modules ...)
+                      (source-properties->location
+                       (current-source-location)))))
+
 (define-syntax-rule (use-package-modules module ...)
-  (use-modules (gnu packages module) ...))
+  (try-use-modules (gnu packages module) ...))
 
 (define-syntax-rule (use-service-modules module ...)
-  (use-modules (gnu services module) ...))
+  (try-use-modules (gnu services module) ...))
 
 (define-syntax-rule (use-system-modules module ...)
-  (use-modules (gnu system module) ...))
+  (try-use-modules (gnu system module) ...))
 
 ;;; gnu.scm ends here
diff --git a/guix/ui.scm b/guix/ui.scm
index 3c8734a7d..cd3a44fb4 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -272,9 +272,15 @@ ARGS is the list of arguments received by the 'throw' 
handler."
                (location->string loc) message)))
     (('srfi-34 obj)
      (if (message-condition? obj)
-         (report-error (G_ "~a~%")
-                       (gettext (condition-message obj)
-                                %gettext-domain))
+         (if (error-location? obj)
+             (format (current-error-port)
+                     (G_ "~a: ~a~%")
+                     (location->string (error-location obj))
+                     (gettext (condition-message obj)
+                              %gettext-domain))
+             (report-error (G_ "~a~%")
+                           (gettext (condition-message obj)
+                                    %gettext-domain)))
          (report-error (G_ "exception thrown: ~s~%") obj)))
     ((error args ...)
      (report-error (G_ "failed to load '~a':~%") file)
@@ -538,6 +544,11 @@ interpreted."
 directories:~{ ~a~}~%")
                     (file-search-error-file-name c)
                     (file-search-error-search-path c)))
+            ((and (error-location? c) (message-condition? c))
+             (format (current-error-port)
+                     (G_ "~a: ~a~%")
+                     (location->string (error-location c))
+                     (gettext (condition-message c) %gettext-domain)))
             ((message-condition? c)
              ;; Normally '&message' error conditions have an i18n'd message.
              (leave (G_ "~a~%")
diff --git a/guix/utils.scm b/guix/utils.scm
index eb1ec29b3..e25e2299e 100644
--- a/guix/utils.scm
+++ b/guix/utils.scm
@@ -28,6 +28,7 @@
   #:use-module (srfi srfi-9)
   #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-26)
+  #:use-module (srfi srfi-35)
   #:use-module (srfi srfi-39)
   #:use-module (ice-9 binary-ports)
   #:autoload   (rnrs io ports) (make-custom-binary-input-port)
@@ -60,6 +61,10 @@
             source-properties->location
             location->source-properties
 
+            &error-location
+            error-location?
+            error-location
+
             nix-system->gnu-triplet
             gnu-triplet->nix-system
             %current-system
@@ -750,6 +755,10 @@ a location object."
     (column   . ,(location-column loc))
     (filename . ,(location-file loc))))
 
+(define-condition-type &error-location &error
+  error-location?
+  (location  error-location))                     ;<location>
+
 ;;; Local Variables:
 ;;; eval: (put 'call-with-progress-reporter 'scheme-indent-function 1)
 ;;; End:
diff --git a/po/guix/POTFILES.in b/po/guix/POTFILES.in
index e3f767cc6..6510b99e8 100644
--- a/po/guix/POTFILES.in
+++ b/po/guix/POTFILES.in
@@ -1,5 +1,6 @@
 # List of source files which contain translatable strings.
 # This should be source files of the various tools, and not package modules.
+gnu.scm
 gnu/packages.scm
 gnu/services.scm
 gnu/system.scm