ui: Add `args-fold*' and use it.

* guix/ui.scm (args-fold*): New procedure.
* guix/scripts/build.scm, guix/scripts/download.scm,
  guix/scripts/gc.scm, guix/scripts/hash.scm, guix/scripts/import.scm,
  guix/scripts/package.scm, guix/scripts/pull.scm,
  guix/scripts/refresh.scm: Use `args-fold*' instead of `args-fold'.

guix/scripts/build.scm

@@ -149,12 +149,12 @@ (define %options
 (define (guix-build . args)
   (define (parse-options)
     ;; Return the alist of option values.
-    (args-fold args %options
+    (args-fold* args %options
-               (lambda (opt name arg result)
+                (lambda (opt name arg result)
-                 (leave (_ "~A: unrecognized option~%") name))
+                  (leave (_ "~A: unrecognized option~%") name))
-               (lambda (arg result)
+                (lambda (arg result)
-                 (alist-cons 'argument arg result))
+                  (alist-cons 'argument arg result))
-               %default-options))
+                %default-options))
 
   (define (register-root paths root)
     ;; Register ROOT as an indirect GC root for all of PATHS.

guix/scripts/download.scm

@@ -90,12 +90,12 @@ (define fmt-proc
 (define (guix-download . args)
   (define (parse-options)
     ;; Return the alist of option values.
-    (args-fold args %options
+    (args-fold* args %options
-               (lambda (opt name arg result)
+                (lambda (opt name arg result)
-                 (leave (_ "~A: unrecognized option~%") name))
+                  (leave (_ "~A: unrecognized option~%") name))
-               (lambda (arg result)
+                (lambda (arg result)
-                 (alist-cons 'argument arg result))
+                  (alist-cons 'argument arg result))
-               %default-options))
+                %default-options))
 
   (with-error-handling
     (let* ((opts  (parse-options))

guix/scripts/gc.scm

@@ -141,12 +141,12 @@ (define %options
 (define (guix-gc . args)
   (define (parse-options)
     ;; Return the alist of option values.
-    (args-fold args %options
+    (args-fold* args %options
-               (lambda (opt name arg result)
+                (lambda (opt name arg result)
-                 (leave (_ "~A: unrecognized option~%") name))
+                  (leave (_ "~A: unrecognized option~%") name))
-               (lambda (arg result)
+                (lambda (arg result)
-                 (alist-cons 'argument arg result))
+                  (alist-cons 'argument arg result))
-               %default-options))
+                %default-options))
 
   (define (symlink-target file)
     (let ((s (false-if-exception (lstat file))))

guix/scripts/hash.scm

@@ -90,13 +90,13 @@ (define fmt-proc
 (define (guix-hash . args)
   (define (parse-options)
     ;; Return the alist of option values.
-    (args-fold args %options
+    (args-fold* args %options
-               (lambda (opt name arg result)
+                (lambda (opt name arg result)
-                 (leave (_ "unrecognized option: ~a~%")
+                  (leave (_ "unrecognized option: ~a~%")
-                        name))
+                         name))
-               (lambda (arg result)
+                (lambda (arg result)
-                 (alist-cons 'argument arg result))
+                  (alist-cons 'argument arg result))
-               %default-options))
+                %default-options))
 
     (let* ((opts (parse-options))
            (args (filter-map (match-lambda

guix/scripts/import.scm

@@ -95,12 +95,12 @@ (define %options
 (define (guix-import . args)
   (define (parse-options)
     ;; Return the alist of option values.
-    (args-fold args %options
+    (args-fold* args %options
-               (lambda (opt name arg result)
+                (lambda (opt name arg result)
-                 (leave (_ "~A: unrecognized option~%") name))
+                  (leave (_ "~A: unrecognized option~%") name))
-               (lambda (arg result)
+                (lambda (arg result)
-                 (alist-cons 'argument arg result))
+                  (alist-cons 'argument arg result))
-               %default-options))
+                %default-options))
 
   (let* ((opts (parse-options))
          (args (filter-map (match-lambda

guix/scripts/package.scm

@@ -446,12 +446,12 @@ (define %options
 (define (guix-package . args)
   (define (parse-options)
     ;; Return the alist of option values.
-    (args-fold args %options
+    (args-fold* args %options
-               (lambda (opt name arg result)
+                (lambda (opt name arg result)
-                 (leave (_ "~A: unrecognized option~%") name))
+                  (leave (_ "~A: unrecognized option~%") name))
-               (lambda (arg result)
+                (lambda (arg result)
-                 (leave (_ "~A: extraneous argument~%") arg))
+                  (leave (_ "~A: extraneous argument~%") arg))
-               %default-options))
+                %default-options))
 
   (define (guile-missing?)
     ;; Return #t if %GUILE-FOR-BUILD is not available yet.

guix/scripts/pull.scm

@@ -173,12 +173,12 @@ (define %options
 (define (guix-pull . args)
   (define (parse-options)
     ;; Return the alist of option values.
-    (args-fold args %options
+    (args-fold* args %options
-               (lambda (opt name arg result)
+                (lambda (opt name arg result)
-                 (leave (_ "~A: unrecognized option~%") name))
+                  (leave (_ "~A: unrecognized option~%") name))
-               (lambda (arg result)
+                (lambda (arg result)
-                 (leave (_ "~A: unexpected argument~%") arg))
+                  (leave (_ "~A: unexpected argument~%") arg))
-               %default-options))
+                %default-options))
 
   (with-error-handling
     (let ((opts  (parse-options))

guix/scripts/refresh.scm

@@ -93,12 +93,12 @@ (define (show-help)
 (define (guix-refresh . args)
   (define (parse-options)
     ;; Return the alist of option values.
-    (args-fold args %options
+    (args-fold* args %options
-               (lambda (opt name arg result)
+                (lambda (opt name arg result)
-                 (leave (_ "~A: unrecognized option~%") name))
+                  (leave (_ "~A: unrecognized option~%") name))
-               (lambda (arg result)
+                (lambda (arg result)
-                 (alist-cons 'argument arg result))
+                  (alist-cons 'argument arg result))
-               %default-options))
+                %default-options))
 
   (define core-package?
     (let* ((input->package (match-lambda

guix/ui.scm

@@ -29,6 +29,7 @@ (define-module (guix ui)
   #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-34)
+  #:use-module (srfi srfi-37)
   #:use-module (ice-9 match)
   #:use-module (ice-9 format)
   #:export (_
@@ -46,6 +47,7 @@ (define-module (guix ui)
             fill-paragraph
             string->recutils
             package->recutils
+            args-fold*
             run-guix-command
             program-name
             guix-warning-port
@@ -370,6 +372,18 @@ (define (description->recutils str)
           (and=> (package-description p) description->recutils))
   (newline port))
 
+(define (args-fold* options unrecognized-option-proc operand-proc . seeds)
+  "A wrapper on top of `args-fold' that does proper user-facing error
+reporting."
+  (catch 'misc-error
+    (lambda ()
+      (apply args-fold options unrecognized-option-proc
+             operand-proc seeds))
+    (lambda (key proc msg args . rest)
+      ;; XXX: MSG is not i18n'd.
+      (leave (_ "invalid argument: ~a~%")
+             (apply format #f msg args)))))
+
 (define (show-guix-usage)
   ;; TODO: Dynamically generate a summary of available commands.
   (format (current-error-port)