~ruther/guix-local

e7fc17b592a0d25c18fbc6774b1f8a6d2a9bbc69 — Ludovic Courtès 12 years ago 98e7fc9
guix build: Factorize common options.

* guix/scripts/build.scm (show-build-options-help,
  set-build-options-from-command-line): New procedures.
  (show-help): Remove description of --dry-run,
  --fallback, --no-substitutes, --max-silent-time, and --cores.  Call
  'show-build-options-help'.
  (%standard-build-options): New variable.
  (%options): Remove --dry-run, --fallback, --no-substitutes,
  --verbosity, --max-silent-time, and --cores.  Add
  %STANDARD-BUILD-OPTIONS.
  (guix-build): Use 'set-build-options-from-command-line' instead of
  'set-build-options'.
* guix/scripts/archive.scm (show-help): Remove description of --dry-run,
  --fallback, --no-substitutes, --max-silent-time, and --cores.  Call
  'show-build-options-help'.
  (%options): Remove --dry-run, --fallback, --no-substitutes,
  --verbosity, --max-silent-time, and --cores.  Add
  %STANDARD-BUILD-OPTIONS.
  (export-from-store): Call 'set-build-options-from-command-line'
  instead of 'set-build-options.
2 files changed, 169 insertions(+), 176 deletions(-)

M guix/scripts/archive.scm
M guix/scripts/build.scm
M guix/scripts/archive.scm => guix/scripts/archive.scm +57 -90
@@ 71,17 71,10 @@ Export/import one or more packages from/to the store.\n"))
  -s, --system=SYSTEM    attempt to build for SYSTEM--e.g., \"i686-linux\""))
  (display (_ "
      --target=TRIPLET   cross-build for TRIPLET--e.g., \"armel-linux-gnu\""))
  (display (_ "
  -n, --dry-run          do not build the derivations"))
  (display (_ "
      --fallback         fall back to building when the substituter fails"))
  (display (_ "
      --no-substitutes   build instead of resorting to pre-built substitutes"))
  (display (_ "
      --max-silent-time=SECONDS
                         mark the build as failed after SECONDS of silence"))
  (display (_ "
  -c, --cores=N          allow the use of up to N CPU cores for the build"))

  (newline)
  (show-build-options-help)

  (newline)
  (display (_ "
  -h, --help             display this help and exit"))


@@ 92,81 85,60 @@ Export/import one or more packages from/to the store.\n"))

(define %options
  ;; Specifications of the command-line options.
  (list (option '(#\h "help") #f #f
                (lambda args
                  (show-help)
                  (exit 0)))
        (option '(#\V "version") #f #f
                (lambda args
                  (show-version-and-exit "guix build")))
  (cons* (option '(#\h "help") #f #f
                 (lambda args
                   (show-help)
                   (exit 0)))
         (option '(#\V "version") #f #f
                 (lambda args
                   (show-version-and-exit "guix build")))

        (option '("export") #f #f
                (lambda (opt name arg result)
                  (alist-cons 'export #t result)))
        (option '("import") #f #f
                (lambda (opt name arg result)
                  (alist-cons 'import #t result)))
        (option '("missing") #f #f
                (lambda (opt name arg result)
                  (alist-cons 'missing #t result)))
        (option '("generate-key") #f #t
                (lambda (opt name arg result)
                  (catch 'gcry-error
                    (lambda ()
                      (let ((params
                             (string->canonical-sexp
                              (or arg "(genkey (rsa (nbits 4:4096)))"))))
                        (alist-cons 'generate-key params result)))
                    (lambda args
                      (leave (_ "invalid key generation parameters: ~s~%")
                             arg)))))
        (option '("authorize") #f #f
                (lambda (opt name arg result)
                  (alist-cons 'authorize #t result)))
         (option '("export") #f #f
                 (lambda (opt name arg result)
                   (alist-cons 'export #t result)))
         (option '("import") #f #f
                 (lambda (opt name arg result)
                   (alist-cons 'import #t result)))
         (option '("missing") #f #f
                 (lambda (opt name arg result)
                   (alist-cons 'missing #t result)))
         (option '("generate-key") #f #t
                 (lambda (opt name arg result)
                   (catch 'gcry-error
                     (lambda ()
                       (let ((params
                              (string->canonical-sexp
                               (or arg "(genkey (rsa (nbits 4:4096)))"))))
                         (alist-cons 'generate-key params result)))
                     (lambda args
                       (leave (_ "invalid key generation parameters: ~s~%")
                              arg)))))
         (option '("authorize") #f #f
                 (lambda (opt name arg result)
                   (alist-cons 'authorize #t result)))

        (option '(#\S "source") #f #f
                (lambda (opt name arg result)
                  (alist-cons 'source? #t result)))
        (option '(#\s "system") #t #f
                (lambda (opt name arg result)
                  (alist-cons 'system arg
                              (alist-delete 'system result eq?))))
        (option '("target") #t #f
                (lambda (opt name arg result)
                  (alist-cons 'target arg
                              (alist-delete 'target result eq?))))
        (option '(#\e "expression") #t #f
                (lambda (opt name arg result)
                  (alist-cons 'expression arg result)))
        (option '(#\c "cores") #t #f
                (lambda (opt name arg result)
                  (let ((c (false-if-exception (string->number arg))))
                    (if c
                        (alist-cons 'cores c result)
                        (leave (_ "~a: not a number~%") arg)))))
        (option '(#\n "dry-run") #f #f
                (lambda (opt name arg result)
                  (alist-cons 'dry-run? #t result)))
        (option '("fallback") #f #f
                (lambda (opt name arg result)
                  (alist-cons 'fallback? #t
                              (alist-delete 'fallback? result))))
        (option '("no-substitutes") #f #f
                (lambda (opt name arg result)
                  (alist-cons 'substitutes? #f
                              (alist-delete 'substitutes? result))))
        (option '("max-silent-time") #t #f
                (lambda (opt name arg result)
                  (alist-cons 'max-silent-time (string->number* arg)
                              result)))
        (option '(#\r "root") #t #f
                (lambda (opt name arg result)
                  (alist-cons 'gc-root arg result)))
        (option '("verbosity") #t #f
                (lambda (opt name arg result)
                  (let ((level (string->number arg)))
                    (alist-cons 'verbosity level
                                (alist-delete 'verbosity result)))))))
         (option '(#\S "source") #f #f
                 (lambda (opt name arg result)
                   (alist-cons 'source? #t result)))
         (option '(#\s "system") #t #f
                 (lambda (opt name arg result)
                   (alist-cons 'system arg
                               (alist-delete 'system result eq?))))
         (option '("target") #t #f
                 (lambda (opt name arg result)
                   (alist-cons 'target arg
                               (alist-delete 'target result eq?))))
         (option '(#\e "expression") #t #f
                 (lambda (opt name arg result)
                   (alist-cons 'expression arg result)))
         (option '(#\n "dry-run") #f #f
                 (lambda (opt name arg result)
                   (alist-cons 'dry-run? #t result)))
         (option '(#\r "root") #t #f
                 (lambda (opt name arg result)
                   (alist-cons 'gc-root arg result)))

         %standard-build-options))

(define (options->derivations+files store opts)
  "Given OPTS, the result of 'args-fold', return a list of derivations to


@@ 219,16 191,11 @@ build and a list of store files to transfer."
resulting archive to the standard output port."
  (let-values (((drv files)
                (options->derivations+files store opts)))
    (set-build-options-from-command-line store opts)
    (show-what-to-build store drv
                        #:use-substitutes? (assoc-ref opts 'substitutes?)
                        #:dry-run? (assoc-ref opts 'dry-run?))

    (set-build-options store
                       #:build-cores (or (assoc-ref opts 'cores) 0)
                       #:fallback? (assoc-ref opts 'fallback?)
                       #:use-substitutes? (assoc-ref opts 'substitutes?)
                       #:max-silent-time (assoc-ref opts 'max-silent-time))

    (if (or (assoc-ref opts 'dry-run?)
            (build-derivations store drv))
        (export-paths store files (current-output-port))

M guix/scripts/build.scm => guix/scripts/build.scm +112 -86
@@ 34,6 34,11 @@
  #:use-module (srfi srfi-37)
  #:autoload   (gnu packages) (find-best-packages-by-name)
  #:export (derivation-from-expression

            %standard-build-options
            set-build-options-from-command-line
            show-build-options-help

            guix-build))

(define (derivation-from-expression store str package-derivation


@@ 101,30 106,13 @@ present, return the preferred newest version."


;;;
;;; Command-line options.
;;; Standard command-line build options.
;;;

(define %default-options
  ;; Alist of default option values.
  `((system . ,(%current-system))
    (substitutes? . #t)
    (build-hook? . #t)
    (max-silent-time . 3600)
    (verbosity . 0)))

(define (show-help)
  (display (_ "Usage: guix build [OPTION]... PACKAGE-OR-DERIVATION...
Build the given PACKAGE-OR-DERIVATION and return their output paths.\n"))
  (display (_ "
  -e, --expression=EXPR  build the package or derivation EXPR evaluates to"))
  (display (_ "
  -S, --source           build the packages' source derivations"))
  (display (_ "
  -s, --system=SYSTEM    attempt to build for SYSTEM--e.g., \"i686-linux\""))
  (display (_ "
      --target=TRIPLET   cross-build for TRIPLET--e.g., \"armel-linux-gnu\""))
  (display (_ "
  -d, --derivations      return the derivation paths of the given packages"))
(define (show-build-options-help)
  "Display on the current output port help about the standard command-line
options handled by 'set-build-options-from-command-line', and listed in
'%standard-build-options'."
  (display (_ "
  -K, --keep-failed      keep build tree of failed builds"))
  (display (_ "


@@ 139,61 127,28 @@ Build the given PACKAGE-OR-DERIVATION and return their output paths.\n"))
      --max-silent-time=SECONDS
                         mark the build as failed after SECONDS of silence"))
  (display (_ "
  -c, --cores=N          allow the use of up to N CPU cores for the build"))
  (display (_ "
  -r, --root=FILE        make FILE a symlink to the result, and register it
                         as a garbage collector root"))
  (display (_ "
      --verbosity=LEVEL  use the given verbosity LEVEL"))
  (display (_ "
      --log-file         return the log file names for the given derivations"))
  (newline)
  (display (_ "
  -h, --help             display this help and exit"))
  (display (_ "
  -V, --version          display version information and exit"))
  (newline)
  (show-bug-report-information))
  -c, --cores=N          allow the use of up to N CPU cores for the build")))

(define %options
  ;; Specifications of the command-line options.
  (list (option '(#\h "help") #f #f
                (lambda args
                  (show-help)
                  (exit 0)))
        (option '(#\V "version") #f #f
                (lambda args
                  (show-version-and-exit "guix build")))
(define (set-build-options-from-command-line store opts)
  "Given OPTS, an alist as returned by 'args-fold' given
'%standard-build-options', set the corresponding build options on STORE."
  ;; TODO: Add more options.
  (set-build-options store
                     #:keep-failed? (assoc-ref opts 'keep-failed?)
                     #:build-cores (or (assoc-ref opts 'cores) 0)
                     #:fallback? (assoc-ref opts 'fallback?)
                     #:use-substitutes? (assoc-ref opts 'substitutes?)
                     #:use-build-hook? (assoc-ref opts 'build-hook?)
                     #:max-silent-time (assoc-ref opts 'max-silent-time)
                     #:verbosity (assoc-ref opts 'verbosity)))

        (option '(#\S "source") #f #f
                (lambda (opt name arg result)
                  (alist-cons 'source? #t result)))
        (option '(#\s "system") #t #f
                (lambda (opt name arg result)
                  (alist-cons 'system arg
                              (alist-delete 'system result eq?))))
        (option '("target") #t #f
                (lambda (opt name arg result)
                  (alist-cons 'target arg
                              (alist-delete 'target result eq?))))
        (option '(#\d "derivations") #f #f
                (lambda (opt name arg result)
                  (alist-cons 'derivations-only? #t result)))
        (option '(#\e "expression") #t #f
                (lambda (opt name arg result)
                  (alist-cons 'expression arg result)))
        (option '(#\K "keep-failed") #f #f
(define %standard-build-options
  ;; List of standard command-line options for tools that build something.
  (list (option '(#\K "keep-failed") #f #f
                (lambda (opt name arg result)
                  (alist-cons 'keep-failed? #t result)))
        (option '(#\c "cores") #t #f
                (lambda (opt name arg result)
                  (let ((c (false-if-exception (string->number arg))))
                    (if c
                        (alist-cons 'cores c result)
                        (leave (_ "~a: not a number~%") arg)))))
        (option '(#\n "dry-run") #f #f
                (lambda (opt name arg result)
                  (alist-cons 'dry-run? #t result)))
        (option '("fallback") #f #f
                (lambda (opt name arg result)
                  (alist-cons 'fallback? #t


@@ 210,17 165,97 @@ Build the given PACKAGE-OR-DERIVATION and return their output paths.\n"))
                (lambda (opt name arg result)
                  (alist-cons 'max-silent-time (string->number* arg)
                              result)))
        (option '(#\r "root") #t #f
                (lambda (opt name arg result)
                  (alist-cons 'gc-root arg result)))
        (option '("verbosity") #t #f
                (lambda (opt name arg result)
                  (let ((level (string->number arg)))
                    (alist-cons 'verbosity level
                                (alist-delete 'verbosity result)))))
        (option '("log-file") #f #f
        (option '(#\c "cores") #t #f
                (lambda (opt name arg result)
                  (alist-cons 'log-file? #t result)))))
                  (let ((c (false-if-exception (string->number arg))))
                    (if c
                        (alist-cons 'cores c result)
                        (leave (_ "~a: not a number~%") arg)))))))


;;;
;;; Command-line options.
;;;

(define %default-options
  ;; Alist of default option values.
  `((system . ,(%current-system))
    (substitutes? . #t)
    (build-hook? . #t)
    (max-silent-time . 3600)
    (verbosity . 0)))

(define (show-help)
  (display (_ "Usage: guix build [OPTION]... PACKAGE-OR-DERIVATION...
Build the given PACKAGE-OR-DERIVATION and return their output paths.\n"))
  (display (_ "
  -e, --expression=EXPR  build the package or derivation EXPR evaluates to"))
  (display (_ "
  -S, --source           build the packages' source derivations"))
  (display (_ "
  -s, --system=SYSTEM    attempt to build for SYSTEM--e.g., \"i686-linux\""))
  (display (_ "
      --target=TRIPLET   cross-build for TRIPLET--e.g., \"armel-linux-gnu\""))
  (display (_ "
  -d, --derivations      return the derivation paths of the given packages"))
  (display (_ "
  -r, --root=FILE        make FILE a symlink to the result, and register it
                         as a garbage collector root"))
  (display (_ "
      --log-file         return the log file names for the given derivations"))
  (newline)
  (show-build-options-help)
  (newline)
  (display (_ "
  -h, --help             display this help and exit"))
  (display (_ "
  -V, --version          display version information and exit"))
  (newline)
  (show-bug-report-information))

(define %options
  ;; Specifications of the command-line options.
  (cons* (option '(#\h "help") #f #f
                 (lambda args
                   (show-help)
                   (exit 0)))
         (option '(#\V "version") #f #f
                 (lambda args
                   (show-version-and-exit "guix build")))

         (option '(#\S "source") #f #f
                 (lambda (opt name arg result)
                   (alist-cons 'source? #t result)))
         (option '(#\s "system") #t #f
                 (lambda (opt name arg result)
                   (alist-cons 'system arg
                               (alist-delete 'system result eq?))))
         (option '("target") #t #f
                 (lambda (opt name arg result)
                   (alist-cons 'target arg
                               (alist-delete 'target result eq?))))
         (option '(#\d "derivations") #f #f
                 (lambda (opt name arg result)
                   (alist-cons 'derivations-only? #t result)))
         (option '(#\e "expression") #t #f
                 (lambda (opt name arg result)
                   (alist-cons 'expression arg result)))
         (option '(#\n "dry-run") #f #f
                 (lambda (opt name arg result)
                   (alist-cons 'dry-run? #t result)))
         (option '(#\r "root") #t #f
                 (lambda (opt name arg result)
                   (alist-cons 'gc-root arg result)))
         (option '("log-file") #f #f
                 (lambda (opt name arg result)
                   (alist-cons 'log-file? #t result)))

         %standard-build-options))

(define (options->derivations store opts)
  "Given OPTS, the result of 'args-fold', return a list of derivations to


@@ 279,16 314,7 @@ build."
                                 (_ #f))
                                opts)))

        ;; TODO: Add more options.
        (set-build-options store
                           #:keep-failed? (assoc-ref opts 'keep-failed?)
                           #:build-cores (or (assoc-ref opts 'cores) 0)
                           #:fallback? (assoc-ref opts 'fallback?)
                           #:use-substitutes? (assoc-ref opts 'substitutes?)
                           #:use-build-hook? (assoc-ref opts 'build-hook?)
                           #:max-silent-time (assoc-ref opts 'max-silent-time)
                           #:verbosity (assoc-ref opts 'verbosity))

        (set-build-options-from-command-line store opts)
        (unless (assoc-ref opts 'log-file?)
          (show-what-to-build store drv
                              #:use-substitutes? (assoc-ref opts 'substitutes?)