guix-build: Add `--source'.

* guix-build.in (derivations-from-package-expressions): Add `source?'
  parameter.  Honor it.
  (show-help): Add `--source'.
  (%options): Likewise.
  (guix-build): Honor `--source'.
This commit is contained in:
Ludovic Courtès 2012-09-04 23:09:04 +02:00
parent ff352cfb97
commit 5dba31494e
1 changed files with 26 additions and 14 deletions

View File

@ -44,11 +44,14 @@ exec ${GUILE-@GUILE@} -L "@guilemoduledir@" -l "$0" \
(define %store (define %store
(open-connection)) (open-connection))
(define (derivations-from-package-expressions exp) (define (derivations-from-package-expressions exp source?)
"Eval EXP and return the corresponding derivation path." "Eval EXP and return the corresponding derivation path. When SOURCE? is
true, return the derivations of the package sources."
(let ((p (eval exp (current-module)))) (let ((p (eval exp (current-module))))
(if (package? p) (if (package? p)
(package-derivation %store p) (if source?
(package-source-derivation %store (package-source p))
(package-derivation %store p))
(begin (begin
(format (current-error-port) (format (current-error-port)
(_ "expression `~s' does not evaluate to a package") (_ "expression `~s' does not evaluate to a package")
@ -79,6 +82,8 @@ Build the given PACKAGE-OR-DERIVATION and return their output paths.\n"))
(display (_ " (display (_ "
-e, --expression=EXPR build the package EXPR evaluates to")) -e, --expression=EXPR build the package EXPR evaluates to"))
(display (_ " (display (_ "
-S, --source build the packages' source derivations"))
(display (_ "
-K, --keep-failed keep build tree of failed builds")) -K, --keep-failed keep build tree of failed builds"))
(display (_ " (display (_ "
-n, --dry-run do not build the derivations")) -n, --dry-run do not build the derivations"))
@ -104,6 +109,9 @@ Report bugs to: ~a.~%") "@PACKAGE_BUGREPORT@"))
(show-version) (show-version)
(exit 0))) (exit 0)))
(option '(#\S "source") #f #f
(lambda (opt name arg result)
(alist-cons 'source? #t result)))
(option '(#\e "expression") #t #f (option '(#\e "expression") #t #f
(lambda (opt name arg result) (lambda (opt name arg result)
(alist-cons 'expression (alist-cons 'expression
@ -143,18 +151,22 @@ Report bugs to: ~a.~%") "@PACKAGE_BUGREPORT@"))
(setvbuf (current-error-port) _IOLBF) (setvbuf (current-error-port) _IOLBF)
(let* ((opts (parse-options)) (let* ((opts (parse-options))
(src? (assoc-ref opts 'source?))
(drv (filter-map (match-lambda (drv (filter-map (match-lambda
(('expression . exp) (('expression . exp)
(derivations-from-package-expressions exp)) (derivations-from-package-expressions exp src?))
(('argument . (? derivation-path? drv)) (('argument . (? derivation-path? drv))
drv) drv)
(('argument . (? string? x)) (('argument . (? string? x))
(match (find-packages-by-name x) (match (find-packages-by-name x)
((p _ ...) ((p _ ...)
(package-derivation %store p)) (if src?
(_ (let ((s (package-source p)))
(leave (_ "~A: unknown package~%") x)))) (package-source-derivation %store s))
(_ #f)) (package-derivation %store p)))
(_
(leave (_ "~A: unknown package~%") x))))
(_ #f))
opts)) opts))
(req (append-map (lambda (drv-path) (req (append-map (lambda (drv-path)
(let ((d (call-with-input-file drv-path (let ((d (call-with-input-file drv-path