guix build: Add '--with-source'.
* guix/scripts/build.scm (package-with-source): New procedure. (show-help): Add '--with-source'. (%options): Likewise. (options->derivations): Call 'options/with-source' and 'options/resolve-packages'. (options/resolve-packages, options/with-source): New procedures. * doc/guix.texi (Invoking guix build): Document '--with-source'.
This commit is contained in:
Ludovic Courtès
parent
d91a879121
commit
7f3673f21d
2 changed files with 122 additions and 14 deletions
|
|
@ -1840,6 +1840,34 @@ Cross-build for @var{triplet}, which must be a valid GNU triplet, such
|
|||
as @code{"mips64el-linux-gnu"} (@pxref{Configuration Names, GNU
|
||||
configuration triplets,, configure, GNU Configure and Build System}).
|
||||
|
||||
@item --with-source=@var{source}
|
||||
Use @var{source} as the source of the corresponding package.
|
||||
@var{source} must be a file name or a URL, as for @command{guix
|
||||
download} (@pxref{Invoking guix download}).
|
||||
|
||||
The ``corresponding package'' is taken to be one specified on the
|
||||
command line whose name matches the base of @var{source}---e.g., if
|
||||
@var{source} is @code{/src/guile-2.0.10.tar.gz}, the corresponding
|
||||
package is @code{guile}. Likewise, the version string is inferred from
|
||||
@var{source}; in the previous example, it's @code{2.0.10}.
|
||||
|
||||
This option allows users to try out versions of packages other than the
|
||||
one provided by the distribution. The example below downloads
|
||||
@file{ed-1.7.tar.gz} from a GNU mirror and uses that as the source for
|
||||
the @code{ed} package:
|
||||
|
||||
@example
|
||||
guix build ed --with-source=mirror://gnu/ed/ed-1.7.tar.gz
|
||||
@end example
|
||||
|
||||
As a developer, @code{--with-source} makes it easy to test release
|
||||
candidates:
|
||||
|
||||
@example
|
||||
guix build guile --with-source=../guile-2.0.9.219-e1bb7.tar.xz
|
||||
@end example
|
||||
|
||||
|
||||
@item --derivations
|
||||
@itemx -d
|
||||
Return the derivation paths, not the output paths, of the given
|
||||
|
|
|
|||
|
|
@ -33,6 +33,7 @@
|
|||
#:use-module (srfi srfi-34)
|
||||
#:use-module (srfi srfi-37)
|
||||
#:autoload (gnu packages) (find-best-packages-by-name)
|
||||
#:autoload (guix download) (download-to-store)
|
||||
#:export (derivation-from-expression
|
||||
|
||||
%standard-build-options
|
||||
|
|
@ -104,6 +105,31 @@ present, return the preferred newest version."
|
|||
(leave (_ "failed to create GC root `~a': ~a~%")
|
||||
root (strerror (system-error-errno args)))))))
|
||||
|
||||
(define (package-with-source store p uri)
|
||||
"Return a package based on P but with its source taken from URI. Extract
|
||||
the new package's version number from URI."
|
||||
(define (numeric-extension? file-name)
|
||||
;; Return true if FILE-NAME ends with digits.
|
||||
(string-every char-set:hex-digit (file-extension file-name)))
|
||||
|
||||
(define (tarball-base-name file-name)
|
||||
;; Return the "base" of FILE-NAME, removing '.tar.gz' or similar
|
||||
;; extensions.
|
||||
;; TODO: Factorize.
|
||||
(cond ((numeric-extension? file-name)
|
||||
file-name)
|
||||
((string=? (file-extension file-name) "tar")
|
||||
(file-sans-extension file-name))
|
||||
(else
|
||||
(tarball-base-name (file-sans-extension file-name)))))
|
||||
|
||||
(let ((base (tarball-base-name (basename uri))))
|
||||
(let-values (((name version)
|
||||
(package-name->name+version base)))
|
||||
(package (inherit p)
|
||||
(version (or version (package-version p)))
|
||||
(source (download-to-store store uri))))))
|
||||
|
||||
|
||||
;;;
|
||||
;;; Standard command-line build options.
|
||||
|
|
@ -221,6 +247,9 @@ Build the given PACKAGE-OR-DERIVATION and return their output paths.\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 (_ "
|
||||
--with-source=SOURCE
|
||||
use SOURCE when building the corresponding package"))
|
||||
(display (_ "
|
||||
-d, --derivations return the derivation paths of the given packages"))
|
||||
(display (_ "
|
||||
|
|
@ -274,6 +303,9 @@ Build the given PACKAGE-OR-DERIVATION and return their output paths.\n"))
|
|||
(option '("log-file") #f #f
|
||||
(lambda (opt name arg result)
|
||||
(alist-cons 'log-file? #t result)))
|
||||
(option '("with-source") #t #f
|
||||
(lambda (opt name arg result)
|
||||
(alist-cons 'with-source arg result)))
|
||||
|
||||
%standard-build-options))
|
||||
|
||||
|
|
@ -289,23 +321,71 @@ build."
|
|||
(define src? (assoc-ref opts 'source?))
|
||||
(define sys (assoc-ref opts 'system))
|
||||
|
||||
(filter-map (match-lambda
|
||||
(('expression . str)
|
||||
(derivation-from-expression store str package->derivation
|
||||
sys src?))
|
||||
(('argument . (? derivation-path? drv))
|
||||
(call-with-input-file drv read-derivation))
|
||||
(('argument . (? store-path?))
|
||||
;; Nothing to do; maybe for --log-file.
|
||||
#f)
|
||||
(('argument . (? string? x))
|
||||
(let ((p (specification->package x)))
|
||||
(let ((opts (options/with-source store
|
||||
(options/resolve-packages opts))))
|
||||
(filter-map (match-lambda
|
||||
(('expression . str)
|
||||
(derivation-from-expression store str package->derivation
|
||||
sys src?))
|
||||
(('argument . (? package? p))
|
||||
(if src?
|
||||
(let ((s (package-source p)))
|
||||
(package-source-derivation store s))
|
||||
(package->derivation store p sys))))
|
||||
(_ #f))
|
||||
opts))
|
||||
(package->derivation store p sys)))
|
||||
(('argument . (? derivation-path? drv))
|
||||
(call-with-input-file drv read-derivation))
|
||||
(('argument . (? store-path?))
|
||||
;; Nothing to do; maybe for --log-file.
|
||||
#f)
|
||||
(_ #f))
|
||||
opts)))
|
||||
|
||||
(define (options/resolve-packages opts)
|
||||
"Return OPTS with package specification strings replaced by actual
|
||||
packages."
|
||||
(map (match-lambda
|
||||
(('argument . (? string? spec))
|
||||
(if (store-path? spec)
|
||||
`(argument . ,spec)
|
||||
`(argument . ,(specification->package spec))))
|
||||
(opt opt))
|
||||
opts))
|
||||
|
||||
(define (options/with-source store opts)
|
||||
"Process with 'with-source' options in OPTS, replacing the relevant package
|
||||
arguments with packages that use the specified source."
|
||||
(define new-sources
|
||||
(filter-map (match-lambda
|
||||
(('with-source . uri)
|
||||
(cons (package-name->name+version (basename uri))
|
||||
uri))
|
||||
(_ #f))
|
||||
opts))
|
||||
|
||||
(let loop ((opts opts)
|
||||
(sources new-sources)
|
||||
(result '()))
|
||||
(match opts
|
||||
(()
|
||||
(unless (null? sources)
|
||||
(warning (_ "sources do not match any package:~{ ~a~}~%")
|
||||
(match sources
|
||||
(((name . uri) ...)
|
||||
uri))))
|
||||
(reverse result))
|
||||
((('argument . (? package? p)) tail ...)
|
||||
(let ((source (assoc-ref sources (package-name p))))
|
||||
(loop tail
|
||||
(alist-delete (package-name p) sources)
|
||||
(alist-cons 'argument
|
||||
(if source
|
||||
(package-with-source store p source)
|
||||
p)
|
||||
result))))
|
||||
((('with-source . _) tail ...)
|
||||
(loop tail sources result))
|
||||
((head tail ...)
|
||||
(loop tail sources (cons head result))))))
|
||||
|
||||
|
||||
;;;
|
||||
|
|
|
|||
Reference in a new issue