~ruther/guix-local

a5975cedf27b3cb149629fe16846a6aeff17a96b — Ludovic Courtès 13 years ago 14e2afa
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'.
M guix/scripts/build.scm => guix/scripts/build.scm +6 -6
@@ 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.

M guix/scripts/download.scm => guix/scripts/download.scm +6 -6
@@ 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))

M guix/scripts/gc.scm => guix/scripts/gc.scm +6 -6
@@ 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))))

M guix/scripts/hash.scm => guix/scripts/hash.scm +7 -7
@@ 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

M guix/scripts/import.scm => guix/scripts/import.scm +6 -6
@@ 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

M guix/scripts/package.scm => guix/scripts/package.scm +6 -6
@@ 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.

M guix/scripts/pull.scm => guix/scripts/pull.scm +6 -6
@@ 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))

M guix/scripts/refresh.scm => guix/scripts/refresh.scm +6 -6
@@ 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

M guix/ui.scm => guix/ui.scm +14 -0
@@ 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)