guix build: Add ‘--development’ option.

* guix/scripts/build.scm (show-help, %options): Add ‘-D’.
(options->things-to-build): Change ‘append-map’ to a loop.  Honor ‘-D’.
* tests/guix-build.sh: Add test.
* doc/guix.texi (Additional Build Options): Document it.

Reviewed-by: Maxim Cournoyer <maxim.cournoyer@gmail.com>
Change-Id: I99227aadfe861e43c001a4872292bd687b37f5d4
This commit is contained in:
Ludovic Courtès 2024-11-24 22:58:22 +01:00
parent bc3c89a475
commit a633422371
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
3 changed files with 112 additions and 37 deletions

View file

@ -13614,6 +13614,31 @@ Lastly, @var{expr} may refer to a zero-argument monadic procedure
(@pxref{The Store Monad}). The procedure must return a derivation as a
monadic value, which is then passed through @code{run-with-store}.
@item --development
@itemx -D
Build the ``development environment'' (build dependencies) of the
following package.
For example, the following command builds the inputs of @code{hello},
but @emph{not} @code{hello} itself, and also builds @code{guile}:
@example
guix build -D hello guile
@end example
Notice that @option{-D} (or @option{--development}) only applies to the
immediately following package on the command line. Under the hood, it
uses @code{package->development-manifest}
(@pxref{package-development-manifest,
@code{package->development-manifest}}).
@quotation Note
The effect of combining @option{--development} with @option{--target}
(for cross-compilation) may not be what you expect: it will
cross-compile all the dependencies of the given package when it is built
natively.
@end quotation
@item --source
@itemx -S
Build the source derivations of the packages, rather than the packages

View file

@ -438,6 +438,8 @@ (define (show-help)
-m, --manifest=FILE build the packages that the manifest given in FILE
evaluates to"))
(display (G_ "
-D, --development build the inputs of the following package"))
(display (G_ "
-S, --source build the packages' source derivations"))
(display (G_ "
--sources[=TYPE] build source derivations; TYPE may optionally be one
@ -522,6 +524,9 @@ (define %options
(option '(#\m "manifest") #t #f
(lambda (opt name arg result)
(alist-cons 'manifest arg result)))
(option '(#\D "development") #f #f
(lambda (opt name arg result)
(alist-cons 'development? #t result)))
(option '(#\n "dry-run") #f #f
(lambda (opt name arg result)
(alist-cons 'dry-run? #t result)))
@ -581,43 +586,83 @@ (define (ensure-list x)
(for-each validate-type lst)
lst))
(append-map (match-lambda
(('argument . (? string? spec))
(cond ((derivation-path? spec)
(catch 'system-error
(lambda ()
;; Ask for absolute file names so that .drv file
;; names passed from the user to 'read-derivation'
;; are absolute when it returns.
(let ((spec (canonicalize-path spec)))
(list (read-derivation-from-file spec))))
(lambda args
;; Non-existent .drv files can be substituted down
;; the road, so don't error out.
(if (= ENOENT (system-error-errno args))
'()
(apply throw args)))))
((store-path? spec)
;; Nothing to do; maybe for --log-file.
'())
(else
(list (specification->package spec)))))
(('file . file)
(let ((file (or (and (string-suffix? ".json" file)
(json->scheme-file file))
file)))
(ensure-list (load* file (make-user-module '())))))
(('manifest . manifest)
(map manifest-entry-item
(manifest-entries
(load* manifest
(make-user-module '((guix profiles) (gnu)))))))
(('expression . str)
(ensure-list (read/eval str)))
(('argument . (? derivation? drv))
drv)
(_ '()))
opts))
(define system
(or (assoc-ref opts 'system) (%current-system)))
;; Process OPTS in "the right order", meaning that if the user typed
;; "-D hello", arrange to see the 'development? option before the "hello"
;; spec.
(let loop ((opts (reverse opts))
(type 'regular)
(result '()))
(define (for-type obj)
;; Return a list of objects corresponding to OBJ adjusted for TYPE.
(match type
('regular
(list obj))
('development
(if (package? obj)
(map manifest-entry-item
(manifest-entries
(package->development-manifest obj system)))
obj))))
(match opts
(()
(reverse result))
((head . tail)
(match head
(('argument . (? string? spec))
(cond ((derivation-path? spec)
(catch 'system-error
(lambda ()
;; Ask for absolute file names so that .drv file
;; names passed from the user to 'read-derivation'
;; are absolute when it returns.
(let ((spec (canonicalize-path spec)))
(loop tail 'regular
(cons (read-derivation-from-file spec)
result))))
(lambda args
;; Non-existent .drv files can be substituted down
;; the road, so don't error out.
(if (= ENOENT (system-error-errno args))
(loop tail 'regular result)
(apply throw args)))))
((store-path? spec)
;; Nothing to do; maybe for --log-file.
(loop tail type result))
(else
(loop tail 'regular
(append (for-type (specification->package spec))
result)))))
(('argument . (? derivation? drv))
(loop tail 'regular (cons drv result)))
(('file . file)
(let ((file (or (and (string-suffix? ".json" file)
(json->scheme-file file))
file)))
(loop tail 'regular
(append (append-map
for-type
(ensure-list (load* file (make-user-module '()))))
result))))
(('manifest . manifest)
(loop tail 'regular
(append (map manifest-entry-item
(manifest-entries
(load* manifest
(make-user-module '((guix profiles)
(gnu))))))
result)))
(('expression . str)
(loop tail 'regular
(append (append-map for-type (ensure-list (read/eval str)))
result)))
(('development? . #t)
(loop tail 'development result))
(_
(loop tail type result)))))))
(define (options->derivations store opts)
"Given OPTS, the result of 'args-fold', return a list of derivations to

View file

@ -190,6 +190,11 @@ test `guix build -d --sources=transitive foo \
| grep -e 'foo\.tar\.gz' -e 'bar\.tar\.gz' -e 'bar\.dat' \
| wc -l` -eq 3
# Building the inputs.
guix build -D hello -n
test `guix build -D hello -d \
| grep -e 'glibc.*\.drv$' -e 'gcc.*\.drv$' -e 'binutils.*\.drv$' \
| wc -l` -ge 3
# Unbound variable in thunked field.
cat > "$module_dir/foo.scm" <<EOF