Browse Source

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'.
gn-latest-20200428
Ludovic Courtès 8 years ago
parent
commit
a5975cedf2
9 changed files with 63 additions and 49 deletions
  1. +6
    -6
      guix/scripts/build.scm
  2. +6
    -6
      guix/scripts/download.scm
  3. +6
    -6
      guix/scripts/gc.scm
  4. +7
    -7
      guix/scripts/hash.scm
  5. +6
    -6
      guix/scripts/import.scm
  6. +6
    -6
      guix/scripts/package.scm
  7. +6
    -6
      guix/scripts/pull.scm
  8. +6
    -6
      guix/scripts/refresh.scm
  9. +14
    -0
      guix/ui.scm

+ 6
- 6
guix/scripts/build.scm View File

@ -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.


+ 6
- 6
guix/scripts/download.scm View File

@ -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))


+ 6
- 6
guix/scripts/gc.scm View File

@ -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))))


+ 7
- 7
guix/scripts/hash.scm View File

@ -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


+ 6
- 6
guix/scripts/import.scm View File

@ -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


+ 6
- 6
guix/scripts/package.scm View File

@ -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.


+ 6
- 6
guix/scripts/pull.scm View File

@ -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))


+ 6
- 6
guix/scripts/refresh.scm View File

@ -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


+ 14
- 0
guix/ui.scm View File

@ -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)


Loading…
Cancel
Save