summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2013-04-27 16:46:39 +0200
committerLudovic Courtès <ludo@gnu.org>2013-04-27 16:46:39 +0200
commita5975cedf27b3cb149629fe16846a6aeff17a96b (patch)
tree7c1be73feb1ebd8605e4fad462bdb3d9feec1959
parent14e2afa74ba5653f263ecfc0b89c704bed237bd5 (diff)
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'.
-rw-r--r--guix/scripts/build.scm12
-rw-r--r--guix/scripts/download.scm12
-rw-r--r--guix/scripts/gc.scm12
-rw-r--r--guix/scripts/hash.scm14
-rw-r--r--guix/scripts/import.scm12
-rw-r--r--guix/scripts/package.scm12
-rw-r--r--guix/scripts/pull.scm12
-rw-r--r--guix/scripts/refresh.scm12
-rw-r--r--guix/ui.scm14
9 files changed, 63 insertions, 49 deletions
diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm
index 0bf154dd41..4464d84dfc 100644
--- a/guix/scripts/build.scm
+++ b/guix/scripts/build.scm
@@ -149,12 +149,12 @@ Build the given PACKAGE-OR-DERIVATION and return their output paths.\n"))
(define (guix-build . args)
(define (parse-options)
;; Return the alist of option values.
- (args-fold args %options
- (lambda (opt name arg result)
- (leave (_ "~A: unrecognized option~%") name))
- (lambda (arg result)
- (alist-cons 'argument arg result))
- %default-options))
+ (args-fold* args %options
+ (lambda (opt name arg result)
+ (leave (_ "~A: unrecognized option~%") name))
+ (lambda (arg result)
+ (alist-cons 'argument arg result))
+ %default-options))
(define (register-root paths root)
;; Register ROOT as an indirect GC root for all of PATHS.
diff --git a/guix/scripts/download.scm b/guix/scripts/download.scm
index 220211e6b8..da5fa5be9e 100644
--- a/guix/scripts/download.scm
+++ b/guix/scripts/download.scm
@@ -90,12 +90,12 @@ Supported formats: 'nix-base32' (default), 'base32', and 'base16'
(define (guix-download . args)
(define (parse-options)
;; Return the alist of option values.
- (args-fold args %options
- (lambda (opt name arg result)
- (leave (_ "~A: unrecognized option~%") name))
- (lambda (arg result)
- (alist-cons 'argument arg result))
- %default-options))
+ (args-fold* args %options
+ (lambda (opt name arg result)
+ (leave (_ "~A: unrecognized option~%") name))
+ (lambda (arg result)
+ (alist-cons 'argument arg result))
+ %default-options))
(with-error-handling
(let* ((opts (parse-options))
diff --git a/guix/scripts/gc.scm b/guix/scripts/gc.scm
index 7625bc46e6..cecb68ec36 100644
--- a/guix/scripts/gc.scm
+++ b/guix/scripts/gc.scm
@@ -141,12 +141,12 @@ interpreted."
(define (guix-gc . args)
(define (parse-options)
;; Return the alist of option values.
- (args-fold args %options
- (lambda (opt name arg result)
- (leave (_ "~A: unrecognized option~%") name))
- (lambda (arg result)
- (alist-cons 'argument arg result))
- %default-options))
+ (args-fold* args %options
+ (lambda (opt name arg result)
+ (leave (_ "~A: unrecognized option~%") name))
+ (lambda (arg result)
+ (alist-cons 'argument arg result))
+ %default-options))
(define (symlink-target file)
(let ((s (false-if-exception (lstat file))))
diff --git a/guix/scripts/hash.scm b/guix/scripts/hash.scm
index ad05a4e66f..deded63136 100644
--- a/guix/scripts/hash.scm
+++ b/guix/scripts/hash.scm
@@ -90,13 +90,13 @@ Supported formats: 'nix-base32' (default), 'base32', and 'base16'
(define (guix-hash . args)
(define (parse-options)
;; Return the alist of option values.
- (args-fold args %options
- (lambda (opt name arg result)
- (leave (_ "unrecognized option: ~a~%")
- name))
- (lambda (arg result)
- (alist-cons 'argument arg result))
- %default-options))
+ (args-fold* args %options
+ (lambda (opt name arg result)
+ (leave (_ "unrecognized option: ~a~%")
+ name))
+ (lambda (arg result)
+ (alist-cons 'argument arg result))
+ %default-options))
(let* ((opts (parse-options))
(args (filter-map (match-lambda
diff --git a/guix/scripts/import.scm b/guix/scripts/import.scm
index 0b95afced1..6f75017d6e 100644
--- a/guix/scripts/import.scm
+++ b/guix/scripts/import.scm
@@ -95,12 +95,12 @@ Import and convert the Nix expression ATTRIBUTE of NIXPKGS.\n"))
(define (guix-import . args)
(define (parse-options)
;; Return the alist of option values.
- (args-fold args %options
- (lambda (opt name arg result)
- (leave (_ "~A: unrecognized option~%") name))
- (lambda (arg result)
- (alist-cons 'argument arg result))
- %default-options))
+ (args-fold* args %options
+ (lambda (opt name arg result)
+ (leave (_ "~A: unrecognized option~%") name))
+ (lambda (arg result)
+ (alist-cons 'argument arg result))
+ %default-options))
(let* ((opts (parse-options))
(args (filter-map (match-lambda
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index c5656efc14..cea49a57f4 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -446,12 +446,12 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
(define (guix-package . args)
(define (parse-options)
;; Return the alist of option values.
- (args-fold args %options
- (lambda (opt name arg result)
- (leave (_ "~A: unrecognized option~%") name))
- (lambda (arg result)
- (leave (_ "~A: extraneous argument~%") arg))
- %default-options))
+ (args-fold* args %options
+ (lambda (opt name arg result)
+ (leave (_ "~A: unrecognized option~%") name))
+ (lambda (arg result)
+ (leave (_ "~A: extraneous argument~%") arg))
+ %default-options))
(define (guile-missing?)
;; Return #t if %GUILE-FOR-BUILD is not available yet.
diff --git a/guix/scripts/pull.scm b/guix/scripts/pull.scm
index f99e8c1e3d..f4135efc99 100644
--- a/guix/scripts/pull.scm
+++ b/guix/scripts/pull.scm
@@ -173,12 +173,12 @@ Download and deploy the latest version of Guix.\n"))
(define (guix-pull . args)
(define (parse-options)
;; Return the alist of option values.
- (args-fold args %options
- (lambda (opt name arg result)
- (leave (_ "~A: unrecognized option~%") name))
- (lambda (arg result)
- (leave (_ "~A: unexpected argument~%") arg))
- %default-options))
+ (args-fold* args %options
+ (lambda (opt name arg result)
+ (leave (_ "~A: unrecognized option~%") name))
+ (lambda (arg result)
+ (leave (_ "~A: unexpected argument~%") arg))
+ %default-options))
(with-error-handling
(let ((opts (parse-options))
diff --git a/guix/scripts/refresh.scm b/guix/scripts/refresh.scm
index da318b07ad..6584282f93 100644
--- a/guix/scripts/refresh.scm
+++ b/guix/scripts/refresh.scm
@@ -93,12 +93,12 @@ specified with `--select'.\n"))
(define (guix-refresh . args)
(define (parse-options)
;; Return the alist of option values.
- (args-fold args %options
- (lambda (opt name arg result)
- (leave (_ "~A: unrecognized option~%") name))
- (lambda (arg result)
- (alist-cons 'argument arg result))
- %default-options))
+ (args-fold* args %options
+ (lambda (opt name arg result)
+ (leave (_ "~A: unrecognized option~%") name))
+ (lambda (arg result)
+ (alist-cons 'argument arg result))
+ %default-options))
(define core-package?
(let* ((input->package (match-lambda
diff --git a/guix/ui.scm b/guix/ui.scm
index f8826cd488..7a37ad2cee 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -29,6 +29,7 @@
#: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 @@
fill-paragraph
string->recutils
package->recutils
+ args-fold*
run-guix-command
program-name
guix-warning-port
@@ -370,6 +372,18 @@ WIDTH columns."
(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)