guix-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

07/07: gnu: Emit a warning when a package module cannot be loaded.


From: Ludovic Courtès
Subject: 07/07: gnu: Emit a warning when a package module cannot be loaded.
Date: Tue, 07 Apr 2015 20:32:27 +0000

civodul pushed a commit to branch core-updates
in repository guix.

commit 4ae7559fd62c03a800b010c228639f18b9f58006
Author: Ludovic Courtès <address@hidden>
Date:   Tue Apr 7 22:27:45 2015 +0200

    gnu: Emit a warning when a package module cannot be loaded.
    
    * guix/ui.scm (warn-about-load-error): New procedure.
    * gnu/packages.scm (package-modules): Wrap 'resolve-interface' call in
      'catch #t', and call 'warn-about-load-error' in handler.
---
 gnu/packages.scm |   12 +++++++++---
 guix/ui.scm      |   16 ++++++++++++++++
 2 files changed, 25 insertions(+), 3 deletions(-)

diff --git a/gnu/packages.scm b/gnu/packages.scm
index 57a3e21..2216c0d 100644
--- a/gnu/packages.scm
+++ b/gnu/packages.scm
@@ -160,9 +160,15 @@ Optionally, narrow the search to SUB-DIRECTORY."
     (string-length directory))
 
   (filter-map (lambda (file)
-                (let ((file (substring file prefix-len)))
-                  (false-if-exception
-                   (resolve-interface (file-name->module-name file)))))
+                (let* ((file   (substring file prefix-len))
+                       (module (file-name->module-name file)))
+                  (catch #t
+                    (lambda ()
+                      (resolve-interface module))
+                    (lambda args
+                      ;; Report the error, but keep going.
+                      (warn-about-load-error module args)
+                      #f))))
               (scheme-files (if sub-directory
                                 (string-append directory "/" sub-directory)
                                 directory))))
diff --git a/guix/ui.scm b/guix/ui.scm
index 80a4a63..9e75a35 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -48,6 +48,7 @@
             report-error
             leave
             report-load-error
+            warn-about-load-error
             show-version-and-exit
             show-bug-report-information
             string->number*
@@ -148,6 +149,21 @@ ARGS is the list of arguments received by the 'throw' 
handler."
      (apply display-error #f (current-error-port) args)
      (exit 1))))
 
+(define (warn-about-load-error file args)         ;FIXME: factorize with ↑
+  "Report the failure to load FILE, a user-provided Scheme file, without
+exiting.  ARGS is the list of arguments received by the 'throw' handler."
+  (match args
+    (('system-error . _)
+     (let ((err (system-error-errno args)))
+       (warning (_ "failed to load '~a': ~a~%") file (strerror err))))
+    (('syntax-error proc message properties form . rest)
+     (let ((loc (source-properties->location properties)))
+       (format (current-error-port) (_ "~a: warning: ~a~%")
+               (location->string loc) message)))
+    ((error args ...)
+     (warning (_ "failed to load '~a':~%") file)
+     (apply display-error #f (current-error-port) args))))
+
 (define (install-locale)
   "Install the current locale settings."
   (catch 'system-error



reply via email to

[Prev in Thread] Current Thread [Next in Thread]