06/07: ui: Add 'report-load-error'.

[Ludovic Courtès]

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

commit 1151f6aeae281ae391f925f5cee086f1c2a0728a
Author: Ludovic Courtès <address@hidden>
Date:   Tue Apr 7 22:07:25 2015 +0200

    ui: Add 'report-load-error'.
    
    * guix/scripts/system.scm (read-operating-system): Replace error
      handling code by a call to 'report-load-error'.
    * guix/ui.scm (report-load-error): New procedure.
---
 guix/scripts/system.scm |   16 +---------------
 guix/ui.scm             |   18 ++++++++++++++++++
 2 files changed, 19 insertions(+), 15 deletions(-)

diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 1b64e6f..1838e89 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -69,21 +69,7 @@
          (set-current-module %user-module)
          (primitive-load file))))
     (lambda args
-      (match args
-        (('system-error . _)
-         (let ((err (system-error-errno args)))
-           (leave (_ "failed to open operating system file '~a': ~a~%")
-                  file (strerror err))))
-        (('syntax-error proc message properties form . rest)
-         (let ((loc (source-properties->location properties)))
-           (format (current-error-port) (_ "~a: error: ~a~%")
-                   (location->string loc) message)
-           (exit 1)))
-        ((error args ...)
-         (report-error (_ "failed to load operating system file '~a':~%")
-                       file)
-         (apply display-error #f (current-error-port) args)
-         (exit 1))))))
+      (report-load-error file args))))
 
 
 ;;;
diff --git a/guix/ui.scm b/guix/ui.scm
index 4929f93..80a4a63 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -47,6 +47,7 @@
             P_
             report-error
             leave
+            report-load-error
             show-version-and-exit
             show-bug-report-information
             string->number*
@@ -130,6 +131,23 @@ messages."
     (report-error args ...)
     (exit 1)))
 
+(define (report-load-error file args)
+  "Report the failure to load FILE, a user-provided Scheme file, and exit.
+ARGS is the list of arguments received by the 'throw' handler."
+  (match args
+    (('system-error . _)
+     (let ((err (system-error-errno args)))
+       (leave (_ "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: error: ~a~%")
+               (location->string loc) message)
+       (exit 1)))
+    ((error args ...)
+     (report-error (_ "failed to load '~a':~%") file)
+     (apply display-error #f (current-error-port) args)
+     (exit 1))))
+
 (define (install-locale)
   "Install the current locale settings."
   (catch 'system-error