summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2014-03-01 18:29:29 +0100
committerLudovic Courtès <ludo@gnu.org>2014-03-01 18:29:29 +0100
commitdd67b429e1644407a928a8c12ab7649bf9c50145 (patch)
tree8e019e4d0bceb953fbbd78a877e7ad938ef1489b
parent00ee3a712f693a5c31af55d10e95db12b1199c3b (diff)
guix package: Use the common build options from (guix scripts build).
* guix/scripts/build.scm (%standard-build-options): Change option handlers to support multiple seeds. * guix/scripts/package.scm (show-help): Remove --dry-run, --fallback, --no-substitutes, and --max-silent-time. (%options): Likewise, and add %STANDARD-BUILD-OPTIONS. (%default-options): Add 'verbosity'. (guix-package): Call 'set-build-options-from-command-line' instead of 'set-build-options'.
-rw-r--r--guix/scripts/build.scm50
-rw-r--r--guix/scripts/package.scm212
2 files changed, 125 insertions, 137 deletions
diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm
index 4a00505022..14b8f2d6bd 100644
--- a/guix/scripts/build.scm
+++ b/guix/scripts/build.scm
@@ -147,34 +147,46 @@ options handled by 'set-build-options-from-command-line', and listed in
(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)))
+ (lambda (opt name arg result . rest)
+ (apply values
+ (alist-cons 'keep-failed? #t result)
+ rest)))
(option '("fallback") #f #f
- (lambda (opt name arg result)
- (alist-cons 'fallback? #t
- (alist-delete 'fallback? result))))
+ (lambda (opt name arg result . rest)
+ (apply values
+ (alist-cons 'fallback? #t
+ (alist-delete 'fallback? result))
+ rest)))
(option '("no-substitutes") #f #f
- (lambda (opt name arg result)
- (alist-cons 'substitutes? #f
- (alist-delete 'substitutes? result))))
+ (lambda (opt name arg result . rest)
+ (apply values
+ (alist-cons 'substitutes? #f
+ (alist-delete 'substitutes? result))
+ rest)))
(option '("no-build-hook") #f #f
- (lambda (opt name arg result)
- (alist-cons 'build-hook? #f
- (alist-delete 'build-hook? result))))
+ (lambda (opt name arg result . rest)
+ (apply values
+ (alist-cons 'build-hook? #f
+ (alist-delete 'build-hook? result))
+ rest)))
(option '("max-silent-time") #t #f
- (lambda (opt name arg result)
- (alist-cons 'max-silent-time (string->number* arg)
- result)))
+ (lambda (opt name arg result . rest)
+ (apply values
+ (alist-cons 'max-silent-time (string->number* arg)
+ result)
+ rest)))
(option '("verbosity") #t #f
- (lambda (opt name arg result)
+ (lambda (opt name arg result . rest)
(let ((level (string->number arg)))
- (alist-cons 'verbosity level
- (alist-delete 'verbosity result)))))
+ (apply values
+ (alist-cons 'verbosity level
+ (alist-delete 'verbosity result))
+ rest))))
(option '(#\c "cores") #t #f
- (lambda (opt name arg result)
+ (lambda (opt name arg result . rest)
(let ((c (false-if-exception (string->number arg))))
(if c
- (alist-cons 'cores c result)
+ (apply values (alist-cons 'cores c result) rest)
(leave (_ "~a: not a number~%") arg)))))))
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index d41a83de8a..6069b203de 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -26,6 +26,7 @@
#:use-module (guix profiles)
#:use-module (guix utils)
#:use-module (guix config)
+ #:use-module (guix scripts build)
#:use-module ((guix build utils) #:select (directory-exists? mkdir-p))
#:use-module ((guix ftp-client) #:select (ftp-open))
#:use-module (ice-9 format)
@@ -460,6 +461,7 @@ ENTRIES, a list of manifest entries, in the context of PROFILE."
;; Alist of default option values.
`((profile . ,%current-profile)
(max-silent-time . 3600)
+ (verbosity . 0)
(substitutes? . #t)))
(define (show-help)
@@ -484,18 +486,9 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
(display (_ "
-d, --delete-generations[=PATTERN]
delete generations matching PATTERN"))
- (newline)
(display (_ "
-p, --profile=PROFILE use PROFILE instead of the user's default profile"))
- (display (_ "
- -n, --dry-run show what would be done without actually doing it"))
- (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"))
+ (newline)
(display (_ "
--bootstrap use the bootstrap Guile to build the profile"))
(display (_ "
@@ -510,6 +503,8 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
-A, --list-available[=REGEXP]
list available packages matching REGEXP"))
(newline)
+ (show-build-options-help)
+ (newline)
(display (_ "
-h, --help display this help and exit"))
(display (_ "
@@ -519,107 +514,94 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
(define %options
;; Specification 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 package")))
-
- (option '(#\i "install") #f #t
- (lambda (opt name arg result arg-handler)
- (let arg-handler ((arg arg) (result result))
- (values (if arg
- (alist-cons 'install arg result)
- result)
- arg-handler))))
- (option '(#\e "install-from-expression") #t #f
- (lambda (opt name arg result arg-handler)
- (values (alist-cons 'install (read/eval-package-expression arg)
- result)
- #f)))
- (option '(#\r "remove") #f #t
- (lambda (opt name arg result arg-handler)
- (let arg-handler ((arg arg) (result result))
- (values (if arg
- (alist-cons 'remove arg result)
- result)
- arg-handler))))
- (option '(#\u "upgrade") #f #t
- (lambda (opt name arg result arg-handler)
- (let arg-handler ((arg arg) (result result))
- (values (alist-cons 'upgrade arg
- ;; Delete any prior "upgrade all"
- ;; command, or else "--upgrade gcc"
- ;; would upgrade everything.
- (delete '(upgrade . #f) result))
- arg-handler))))
- (option '("roll-back") #f #f
- (lambda (opt name arg result arg-handler)
- (values (alist-cons 'roll-back? #t result)
- #f)))
- (option '(#\l "list-generations") #f #t
- (lambda (opt name arg result arg-handler)
- (values (cons `(query list-generations ,(or arg ""))
- result)
- #f)))
- (option '(#\d "delete-generations") #f #t
- (lambda (opt name arg result arg-handler)
- (values (alist-cons 'delete-generations (or arg "")
- result)
- #f)))
- (option '("search-paths") #f #f
- (lambda (opt name arg result arg-handler)
- (values (cons `(query search-paths) result)
- #f)))
- (option '(#\p "profile") #t #f
- (lambda (opt name arg result arg-handler)
- (values (alist-cons 'profile arg
- (alist-delete 'profile result))
- #f)))
- (option '(#\n "dry-run") #f #f
- (lambda (opt name arg result arg-handler)
- (values (alist-cons 'dry-run? #t result)
- #f)))
- (option '("fallback") #f #f
- (lambda (opt name arg result arg-handler)
- (values (alist-cons 'fallback? #t
- (alist-delete 'fallback? result))
- #f)))
- (option '("no-substitutes") #f #f
- (lambda (opt name arg result arg-handler)
- (values (alist-cons 'substitutes? #f
- (alist-delete 'substitutes? result))
- #f)))
- (option '("max-silent-time") #t #f
- (lambda (opt name arg result arg-handler)
- (values (alist-cons 'max-silent-time (string->number* arg)
- result)
- #f)))
- (option '("bootstrap") #f #f
- (lambda (opt name arg result arg-handler)
- (values (alist-cons 'bootstrap? #t result)
- #f)))
- (option '("verbose") #f #f
- (lambda (opt name arg result arg-handler)
- (values (alist-cons 'verbose? #t result)
- #f)))
- (option '(#\s "search") #t #f
- (lambda (opt name arg result arg-handler)
- (values (cons `(query search ,(or arg ""))
- result)
- #f)))
- (option '(#\I "list-installed") #f #t
- (lambda (opt name arg result arg-handler)
- (values (cons `(query list-installed ,(or arg ""))
- result)
- #f)))
- (option '(#\A "list-available") #f #t
- (lambda (opt name arg result arg-handler)
- (values (cons `(query list-available ,(or arg ""))
- result)
- #f)))))
+ (cons* (option '(#\h "help") #f #f
+ (lambda args
+ (show-help)
+ (exit 0)))
+ (option '(#\V "version") #f #f
+ (lambda args
+ (show-version-and-exit "guix package")))
+
+ (option '(#\i "install") #f #t
+ (lambda (opt name arg result arg-handler)
+ (let arg-handler ((arg arg) (result result))
+ (values (if arg
+ (alist-cons 'install arg result)
+ result)
+ arg-handler))))
+ (option '(#\e "install-from-expression") #t #f
+ (lambda (opt name arg result arg-handler)
+ (values (alist-cons 'install (read/eval-package-expression arg)
+ result)
+ #f)))
+ (option '(#\r "remove") #f #t
+ (lambda (opt name arg result arg-handler)
+ (let arg-handler ((arg arg) (result result))
+ (values (if arg
+ (alist-cons 'remove arg result)
+ result)
+ arg-handler))))
+ (option '(#\u "upgrade") #f #t
+ (lambda (opt name arg result arg-handler)
+ (let arg-handler ((arg arg) (result result))
+ (values (alist-cons 'upgrade arg
+ ;; Delete any prior "upgrade all"
+ ;; command, or else "--upgrade gcc"
+ ;; would upgrade everything.
+ (delete '(upgrade . #f) result))
+ arg-handler))))
+ (option '("roll-back") #f #f
+ (lambda (opt name arg result arg-handler)
+ (values (alist-cons 'roll-back? #t result)
+ #f)))
+ (option '(#\l "list-generations") #f #t
+ (lambda (opt name arg result arg-handler)
+ (values (cons `(query list-generations ,(or arg ""))
+ result)
+ #f)))
+ (option '(#\d "delete-generations") #f #t
+ (lambda (opt name arg result arg-handler)
+ (values (alist-cons 'delete-generations (or arg "")
+ result)
+ #f)))
+ (option '("search-paths") #f #f
+ (lambda (opt name arg result arg-handler)
+ (values (cons `(query search-paths) result)
+ #f)))
+ (option '(#\p "profile") #t #f
+ (lambda (opt name arg result arg-handler)
+ (values (alist-cons 'profile arg
+ (alist-delete 'profile result))
+ #f)))
+ (option '(#\n "dry-run") #f #f
+ (lambda (opt name arg result arg-handler)
+ (values (alist-cons 'dry-run? #t result)
+ #f)))
+ (option '("bootstrap") #f #f
+ (lambda (opt name arg result arg-handler)
+ (values (alist-cons 'bootstrap? #t result)
+ #f)))
+ (option '("verbose") #f #f
+ (lambda (opt name arg result arg-handler)
+ (values (alist-cons 'verbose? #t result)
+ #f)))
+ (option '(#\s "search") #t #f
+ (lambda (opt name arg result arg-handler)
+ (values (cons `(query search ,(or arg ""))
+ result)
+ #f)))
+ (option '(#\I "list-installed") #f #t
+ (lambda (opt name arg result arg-handler)
+ (values (cons `(query list-installed ,(or arg ""))
+ result)
+ #f)))
+ (option '(#\A "list-available") #f #t
+ (lambda (opt name arg result arg-handler)
+ (values (cons `(query list-available ,(or arg ""))
+ result)
+ #f)))
+
+ %standard-build-options))
(define (options->installable opts manifest)
"Given MANIFEST, the current manifest, and OPTS, the result of 'args-fold',
@@ -1052,13 +1034,7 @@ more information.~%"))
(or (process-query opts)
(with-error-handling
(parameterize ((%store (open-connection)))
- (set-build-options (%store)
- #:print-build-trace #f
- #:fallback? (assoc-ref opts 'fallback?)
- #:use-substitutes?
- (assoc-ref opts 'substitutes?)
- #:max-silent-time
- (assoc-ref opts 'max-silent-time))
+ (set-build-options-from-command-line (%store) opts)
(parameterize ((%guile-for-build
(package-derivation (%store)