[bug#74542] [PATCH v2 04/16] guix build: Add ‘--development’ option.

["Ludovic Courtès" <ludo@gnu.org>]

* 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.

Change-Id: I99227aadfe861e43c001a4872292bd687b37f5d4
---
 doc/guix.texi          |  25 +++++++++
 guix/scripts/build.scm | 119 ++++++++++++++++++++++++++++-------------
 tests/guix-build.sh    |   5 ++
 3 files changed, 112 insertions(+), 37 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 26488b41c8..a9d0d044ae 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -13614,6 +13614,31 @@ Additional Build Options
 (@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
diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm
index 9e05bb532b..e8384c8d2d 100644
--- a/guix/scripts/build.scm
+++ b/guix/scripts/build.scm
@@ -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-public my-package
       (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
diff --git a/tests/guix-build.sh b/tests/guix-build.sh
index 36eac2b7e0..3637bcdeb3 100644
--- a/tests/guix-build.sh
+++ b/tests/guix-build.sh
@@ -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
-- 
2.46.0