summaryrefslogtreecommitdiff
path: root/guix/scripts
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2014-02-18 00:13:06 +0100
committerLudovic Courtès <ludo@gnu.org>2014-02-18 00:13:24 +0100
commite7fc17b592a0d25c18fbc6774b1f8a6d2a9bbc69 (patch)
tree51a93229e15bef7b14c96b3684891861d7b77b57 /guix/scripts
parent98e7fc9b02f00f3f2324b12dec1a6cd9beafbe01 (diff)
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.
Diffstat (limited to 'guix/scripts')
-rw-r--r--guix/scripts/archive.scm147
-rw-r--r--guix/scripts/build.scm198
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?)