diff options
author | Ludovic Courtès <ludo@gnu.org> | 2014-02-18 00:13:06 +0100 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2014-02-18 00:13:24 +0100 |
commit | e7fc17b592a0d25c18fbc6774b1f8a6d2a9bbc69 (patch) | |
tree | 51a93229e15bef7b14c96b3684891861d7b77b57 | |
parent | 98e7fc9b02f00f3f2324b12dec1a6cd9beafbe01 (diff) | |
download | guix-e7fc17b592a0d25c18fbc6774b1f8a6d2a9bbc69.tar.gz guix-e7fc17b592a0d25c18fbc6774b1f8a6d2a9bbc69.zip |
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.
-rw-r--r-- | guix/scripts/archive.scm | 147 | ||||
-rw-r--r-- | guix/scripts/build.scm | 198 |
2 files changed, 169 insertions, 176 deletions
diff --git a/guix/scripts/archive.scm b/guix/scripts/archive.scm index 32690c6b45..4788468584 100644 --- a/guix/scripts/archive.scm +++ b/guix/scripts/archive.scm @@ -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)) diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm index b153da8493..4a00505022 100644 --- a/guix/scripts/build.scm +++ b/guix/scripts/build.scm @@ -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?) |