me/guix
Archived
1
0
Fork 0
Code Activity

guix package: Use the common build options from (guix scripts build).

Browse source 
* 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'.
This commit is contained in:
Ludovic Courtès 2014-03-01 18:29:29 +01:00
parent 00ee3a712f
commit dd67b429e1
2 changed files with 124 additions and 136 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

50
guix/scripts/build.scm
View file

@ -147,34 +147,46 @@ options handled by 'set-build-options-from-command-line', and listed in
(define %standard-build-options (define %standard-build-options
;; List of standard command-line options for tools that build something. ;; List of standard command-line options for tools that build something.
(list (option '(#\K "keep-failed") #f #f (list (option '(#\K "keep-failed") #f #f
(lambda (opt name arg result) (lambda (opt name arg result . rest)
(alist-cons 'keep-failed? #t result))) (apply values
(alist-cons 'keep-failed? #t result)
rest)))
(option '("fallback") #f #f (option '("fallback") #f #f
(lambda (opt name arg result) (lambda (opt name arg result . rest)
(alist-cons 'fallback? #t (apply values
(alist-delete 'fallback? result)))) (alist-cons 'fallback? #t
(alist-delete 'fallback? result))
rest)))
(option '("no-substitutes") #f #f (option '("no-substitutes") #f #f
(lambda (opt name arg result) (lambda (opt name arg result . rest)
(alist-cons 'substitutes? #f (apply values
(alist-delete 'substitutes? result)))) (alist-cons 'substitutes? #f
(alist-delete 'substitutes? result))
rest)))
(option '("no-build-hook") #f #f (option '("no-build-hook") #f #f
(lambda (opt name arg result) (lambda (opt name arg result . rest)
(alist-cons 'build-hook? #f (apply values
(alist-delete 'build-hook? result)))) (alist-cons 'build-hook? #f
(alist-delete 'build-hook? result))
rest)))
(option '("max-silent-time") #t #f (option '("max-silent-time") #t #f
(lambda (opt name arg result) (lambda (opt name arg result . rest)
(alist-cons 'max-silent-time (string->number* arg) (apply values
result))) (alist-cons 'max-silent-time (string->number* arg)
result)
rest)))
(option '("verbosity") #t #f (option '("verbosity") #t #f
(lambda (opt name arg result) (lambda (opt name arg result . rest)
(let ((level (string->number arg))) (let ((level (string->number arg)))
(alist-cons 'verbosity level (apply values
(alist-delete 'verbosity result))))) (alist-cons 'verbosity level
(alist-delete 'verbosity result))
rest))))
(option '(#\c "cores") #t #f (option '(#\c "cores") #t #f
(lambda (opt name arg result) (lambda (opt name arg result . rest)
(let ((c (false-if-exception (string->number arg)))) (let ((c (false-if-exception (string->number arg))))
(if c (if c
(alist-cons 'cores c result) (apply values (alist-cons 'cores c result) rest)
(leave (_ "~a: not a number~%") arg))))))) (leave (_ "~a: not a number~%") arg)))))))

210
guix/scripts/package.scm
View file

@ -26,6 +26,7 @@
#:use-module (guix profiles) #:use-module (guix profiles)
#:use-module (guix utils) #:use-module (guix utils)
#:use-module (guix config) #:use-module (guix config)
#:use-module (guix scripts build)
#:use-module ((guix build utils) #:select (directory-exists? mkdir-p)) #:use-module ((guix build utils) #:select (directory-exists? mkdir-p))
#:use-module ((guix ftp-client) #:select (ftp-open)) #:use-module ((guix ftp-client) #:select (ftp-open))
#:use-module (ice-9 format) #: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. ;; Alist of default option values.
`((profile . ,%current-profile) `((profile . ,%current-profile)
(max-silent-time . 3600) (max-silent-time . 3600)
(verbosity . 0)
(substitutes? . #t))) (substitutes? . #t)))
(define (show-help) (define (show-help)
@ -484,18 +486,9 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
(display (_ " (display (_ "
-d, --delete-generations[=PATTERN] -d, --delete-generations[=PATTERN]
delete generations matching PATTERN")) delete generations matching PATTERN"))
(newline)
(display (_ " (display (_ "
-p, --profile=PROFILE use PROFILE instead of the user's default profile")) -p, --profile=PROFILE use PROFILE instead of the user's default profile"))
(display (_ " (newline)
-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"))
(display (_ " (display (_ "
--bootstrap use the bootstrap Guile to build the profile")) --bootstrap use the bootstrap Guile to build the profile"))
(display (_ " (display (_ "
@ -510,6 +503,8 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
-A, --list-available[=REGEXP] -A, --list-available[=REGEXP]
list available packages matching REGEXP")) list available packages matching REGEXP"))
(newline) (newline)
(show-build-options-help)
(newline)
(display (_ " (display (_ "
-h, --help display this help and exit")) -h, --help display this help and exit"))
(display (_ " (display (_ "
@ -519,107 +514,94 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
(define %options (define %options
;; Specification of the command-line options. ;; Specification of the command-line options.
(list (option '(#\h "help") #f #f (cons* (option '(#\h "help") #f #f
(lambda args (lambda args
(show-help) (show-help)
(exit 0))) (exit 0)))
(option '(#\V "version") #f #f (option '(#\V "version") #f #f
(lambda args (lambda args
(show-version-and-exit "guix package"))) (show-version-and-exit "guix package")))
(option '(#\i "install") #f #t (option '(#\i "install") #f #t
(lambda (opt name arg result arg-handler) (lambda (opt name arg result arg-handler)
(let arg-handler ((arg arg) (result result)) (let arg-handler ((arg arg) (result result))
(values (if arg (values (if arg
(alist-cons 'install arg result) (alist-cons 'install arg result)
result) result)
arg-handler)))) arg-handler))))
(option '(#\e "install-from-expression") #t #f (option '(#\e "install-from-expression") #t #f
(lambda (opt name arg result arg-handler) (lambda (opt name arg result arg-handler)
(values (alist-cons 'install (read/eval-package-expression arg) (values (alist-cons 'install (read/eval-package-expression arg)
result) result)
#f))) #f)))
(option '(#\r "remove") #f #t (option '(#\r "remove") #f #t
(lambda (opt name arg result arg-handler) (lambda (opt name arg result arg-handler)
(let arg-handler ((arg arg) (result result)) (let arg-handler ((arg arg) (result result))
(values (if arg (values (if arg
(alist-cons 'remove arg result) (alist-cons 'remove arg result)
result) result)
arg-handler)))) arg-handler))))
(option '(#\u "upgrade") #f #t (option '(#\u "upgrade") #f #t
(lambda (opt name arg result arg-handler) (lambda (opt name arg result arg-handler)
(let arg-handler ((arg arg) (result result)) (let arg-handler ((arg arg) (result result))
(values (alist-cons 'upgrade arg (values (alist-cons 'upgrade arg
;; Delete any prior "upgrade all" ;; Delete any prior "upgrade all"
;; command, or else "--upgrade gcc" ;; command, or else "--upgrade gcc"
;; would upgrade everything. ;; would upgrade everything.
(delete '(upgrade . #f) result)) (delete '(upgrade . #f) result))
arg-handler)))) arg-handler))))
(option '("roll-back") #f #f (option '("roll-back") #f #f
(lambda (opt name arg result arg-handler) (lambda (opt name arg result arg-handler)
(values (alist-cons 'roll-back? #t result) (values (alist-cons 'roll-back? #t result)
#f))) #f)))
(option '(#\l "list-generations") #f #t (option '(#\l "list-generations") #f #t
(lambda (opt name arg result arg-handler) (lambda (opt name arg result arg-handler)
(values (cons `(query list-generations ,(or arg "")) (values (cons `(query list-generations ,(or arg ""))
result) result)
#f))) #f)))
(option '(#\d "delete-generations") #f #t (option '(#\d "delete-generations") #f #t
(lambda (opt name arg result arg-handler) (lambda (opt name arg result arg-handler)
(values (alist-cons 'delete-generations (or arg "") (values (alist-cons 'delete-generations (or arg "")
result) result)
#f))) #f)))
(option '("search-paths") #f #f (option '("search-paths") #f #f
(lambda (opt name arg result arg-handler) (lambda (opt name arg result arg-handler)
(values (cons `(query search-paths) result) (values (cons `(query search-paths) result)
#f))) #f)))
(option '(#\p "profile") #t #f (option '(#\p "profile") #t #f
(lambda (opt name arg result arg-handler) (lambda (opt name arg result arg-handler)
(values (alist-cons 'profile arg (values (alist-cons 'profile arg
(alist-delete 'profile result)) (alist-delete 'profile result))
#f))) #f)))
(option '(#\n "dry-run") #f #f (option '(#\n "dry-run") #f #f
(lambda (opt name arg result arg-handler) (lambda (opt name arg result arg-handler)
(values (alist-cons 'dry-run? #t result) (values (alist-cons 'dry-run? #t result)
#f))) #f)))
(option '("fallback") #f #f (option '("bootstrap") #f #f
(lambda (opt name arg result arg-handler) (lambda (opt name arg result arg-handler)
(values (alist-cons 'fallback? #t (values (alist-cons 'bootstrap? #t result)
(alist-delete 'fallback? result)) #f)))
#f))) (option '("verbose") #f #f
(option '("no-substitutes") #f #f (lambda (opt name arg result arg-handler)
(lambda (opt name arg result arg-handler) (values (alist-cons 'verbose? #t result)
(values (alist-cons 'substitutes? #f #f)))
(alist-delete 'substitutes? result)) (option '(#\s "search") #t #f
#f))) (lambda (opt name arg result arg-handler)
(option '("max-silent-time") #t #f (values (cons `(query search ,(or arg ""))
(lambda (opt name arg result arg-handler) result)
(values (alist-cons 'max-silent-time (string->number* arg) #f)))
result) (option '(#\I "list-installed") #f #t
#f))) (lambda (opt name arg result arg-handler)
(option '("bootstrap") #f #f (values (cons `(query list-installed ,(or arg ""))
(lambda (opt name arg result arg-handler) result)
(values (alist-cons 'bootstrap? #t result) #f)))
#f))) (option '(#\A "list-available") #f #t
(option '("verbose") #f #f (lambda (opt name arg result arg-handler)
(lambda (opt name arg result arg-handler) (values (cons `(query list-available ,(or arg ""))
(values (alist-cons 'verbose? #t result) result)
#f))) #f)))
(option '(#\s "search") #t #f
(lambda (opt name arg result arg-handler) %standard-build-options))
(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)))))
(define (options->installable opts manifest) (define (options->installable opts manifest)
"Given MANIFEST, the current manifest, and OPTS, the result of 'args-fold', "Given MANIFEST, the current manifest, and OPTS, the result of 'args-fold',
@ -1052,13 +1034,7 @@ more information.~%"))
(or (process-query opts) (or (process-query opts)
(with-error-handling (with-error-handling
(parameterize ((%store (open-connection))) (parameterize ((%store (open-connection)))
(set-build-options (%store) (set-build-options-from-command-line (%store) opts)
#:print-build-trace #f
#:fallback? (assoc-ref opts 'fallback?)
#:use-substitutes?
(assoc-ref opts 'substitutes?)
#:max-silent-time
(assoc-ref opts 'max-silent-time))
(parameterize ((%guile-for-build (parameterize ((%guile-for-build
(package-derivation (%store) (package-derivation (%store)