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'.
This commit is contained in:
parent
14e2afa74b
commit
a5975cedf2
|
@ -149,7 +149,7 @@ Build the given PACKAGE-OR-DERIVATION and return their output paths.\n"))
|
||||||
(define (guix-build . args)
|
(define (guix-build . args)
|
||||||
(define (parse-options)
|
(define (parse-options)
|
||||||
;; Return the alist of option values.
|
;; 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)
|
||||||
|
|
|
@ -90,7 +90,7 @@ Supported formats: 'nix-base32' (default), 'base32', and 'base16'
|
||||||
(define (guix-download . args)
|
(define (guix-download . args)
|
||||||
(define (parse-options)
|
(define (parse-options)
|
||||||
;; Return the alist of option values.
|
;; 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)
|
||||||
|
|
|
@ -141,7 +141,7 @@ interpreted."
|
||||||
(define (guix-gc . args)
|
(define (guix-gc . args)
|
||||||
(define (parse-options)
|
(define (parse-options)
|
||||||
;; Return the alist of option values.
|
;; 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)
|
||||||
|
|
|
@ -90,7 +90,7 @@ Supported formats: 'nix-base32' (default), 'base32', and 'base16'
|
||||||
(define (guix-hash . args)
|
(define (guix-hash . args)
|
||||||
(define (parse-options)
|
(define (parse-options)
|
||||||
;; Return the alist of option values.
|
;; 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))
|
||||||
|
|
|
@ -95,7 +95,7 @@ Import and convert the Nix expression ATTRIBUTE of NIXPKGS.\n"))
|
||||||
(define (guix-import . args)
|
(define (guix-import . args)
|
||||||
(define (parse-options)
|
(define (parse-options)
|
||||||
;; Return the alist of option values.
|
;; 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)
|
||||||
|
|
|
@ -446,7 +446,7 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
|
||||||
(define (guix-package . args)
|
(define (guix-package . args)
|
||||||
(define (parse-options)
|
(define (parse-options)
|
||||||
;; Return the alist of option values.
|
;; 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)
|
||||||
|
|
|
@ -173,7 +173,7 @@ Download and deploy the latest version of Guix.\n"))
|
||||||
(define (guix-pull . args)
|
(define (guix-pull . args)
|
||||||
(define (parse-options)
|
(define (parse-options)
|
||||||
;; Return the alist of option values.
|
;; 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)
|
||||||
|
|
|
@ -93,7 +93,7 @@ specified with `--select'.\n"))
|
||||||
(define (guix-refresh . args)
|
(define (guix-refresh . args)
|
||||||
(define (parse-options)
|
(define (parse-options)
|
||||||
;; Return the alist of option values.
|
;; 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)
|
||||||
|
|
14
guix/ui.scm
14
guix/ui.scm
|
@ -29,6 +29,7 @@
|
||||||
#:use-module (srfi srfi-11)
|
#:use-module (srfi srfi-11)
|
||||||
#:use-module (srfi srfi-26)
|
#:use-module (srfi srfi-26)
|
||||||
#:use-module (srfi srfi-34)
|
#:use-module (srfi srfi-34)
|
||||||
|
#:use-module (srfi srfi-37)
|
||||||
#:use-module (ice-9 match)
|
#:use-module (ice-9 match)
|
||||||
#:use-module (ice-9 format)
|
#:use-module (ice-9 format)
|
||||||
#:export (_
|
#:export (_
|
||||||
|
@ -46,6 +47,7 @@
|
||||||
fill-paragraph
|
fill-paragraph
|
||||||
string->recutils
|
string->recutils
|
||||||
package->recutils
|
package->recutils
|
||||||
|
args-fold*
|
||||||
run-guix-command
|
run-guix-command
|
||||||
program-name
|
program-name
|
||||||
guix-warning-port
|
guix-warning-port
|
||||||
|
@ -370,6 +372,18 @@ WIDTH columns."
|
||||||
(and=> (package-description p) description->recutils))
|
(and=> (package-description p) description->recutils))
|
||||||
(newline port))
|
(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)
|
(define (show-guix-usage)
|
||||||
;; TODO: Dynamically generate a summary of available commands.
|
;; TODO: Dynamically generate a summary of available commands.
|
||||||
(format (current-error-port)
|
(format (current-error-port)
|
||||||
|
|
Loading…
Reference in New Issue