10/10: guix build: Add '--with-input'.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit 47c0f92c37dc7d50d9d4598ce5b91c4cdfec6ed1
Author: Ludovic Courtès <address@hidden>
Date:   Sun Jan 31 23:22:18 2016 +0100

    guix build: Add '--with-input'.
    
    * guix/scripts/build.scm (transform-package-inputs): New procedure.
    (%transformations): Add it.
    (%transformation-options, show-transformation-options-help): Add
    --with-input.
    * tests/scripts-build.scm ("options->transformation, with-input"):
    ("options->transformation, with-input, no matches"): New tests.
    * tests/guix-build.sh: Add tests.
    * doc/guix.texi (Package Transformation Options): Document it.
---
 doc/guix.texi           |   19 ++++++++++++++++
 guix/scripts/build.scm  |   55 +++++++++++++++++++++++++++++++++++++++++++++-
 tests/guix-build.sh     |   14 +++++++++++-
 tests/scripts-build.scm |   23 +++++++++++++++++++
 4 files changed, 108 insertions(+), 3 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index dcced79..11664f4 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -3995,6 +3995,25 @@ $ git clone git://git.sv.gnu.org/guix.git
 $ guix build guix --with-source=./guix
 @end example
 
address@hidden address@hidden@var{replacement}
+Replace dependency on @var{package} by a dependency on
address@hidden  @var{package} must be a package name, and
address@hidden must be a package specification such as @code{guile}
+or @code{guile@@1.8}.
+
+For instance, the following command builds Guix but replaces its
+dependency on the current stable version of Guile with a dependency on
+the development version of Guile, @code{guile-next}:
+
address@hidden
+guix build --with-input=guile=guile-next guix
address@hidden example
+
+This is a recursive, deep replacement.  So in this example, both
address@hidden and its dependency @code{guile-json} (which also depends on
address@hidden) get rebuilt against @code{guile-next}.
+
+However, implicit inputs are left unchanged.
 @end table
 
 @node Additional Build Options
diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm
index b37d923..aa9c105 100644
--- a/guix/scripts/build.scm
+++ b/guix/scripts/build.scm
@@ -169,12 +169,55 @@ matching URIs given in SOURCES."
         (_
          obj)))))
 
+(define (transform-package-inputs replacement-specs)
+  "Return a procedure that, when passed a package, replaces its direct
+dependencies according to REPLACEMENT-SPECS.  REPLACEMENT-SPECS is a list of
+strings like \"address@hidden" meaning that, any direct dependency on a
+package called \"guile\" must be replaced with a dependency on a version 2.1
+of \"guile\"."
+  (define not-equal
+    (char-set-complement (char-set #\=)))
+
+  (define replacements
+    ;; List of name/package pairs.
+    (map (lambda (spec)
+           (match (string-tokenize spec not-equal)
+             ((old new)
+              (cons old (specification->package new)))
+             (_
+              (leave (_ "invalid replacement specification: ~s~%") spec))))
+         replacement-specs))
+
+  (define (rewrite input)
+    (match input
+      ((label (? package? package) outputs ...)
+       (match (assoc-ref replacements (package-name package))
+         (#f  (cons* label (replace package) outputs))
+         (new (cons* label new outputs))))
+      (_
+       input)))
+
+  (define replace
+    (memoize                                      ;XXX: use eq?
+     (lambda (p)
+       (package
+         (inherit p)
+         (inputs (map rewrite (package-inputs p)))
+         (native-inputs (map rewrite (package-native-inputs p)))
+         (propagated-inputs (map rewrite (package-propagated-inputs p)))))))
+
+  (lambda (store obj)
+    (if (package? obj)
+        (replace obj)
+        obj)))
+
 (define %transformations
   ;; Transformations that can be applied to things to build.  The car is the
   ;; key used in the option alist, and the cdr is the transformation
   ;; procedure; it is called with two arguments: the store, and a list of
   ;; things to build.
-  `((with-source . ,transform-package-source)))
+  `((with-source . ,transform-package-source)
+    (with-input  . ,transform-package-inputs)))
 
 (define %transformation-options
   ;; The command-line interface to the above transformations.
@@ -182,12 +225,20 @@ matching URIs given in SOURCES."
                 (lambda (opt name arg result . rest)
                   (apply values
                          (cons (alist-cons 'with-source arg result)
+                               rest))))
+        (option '("with-input") #t #f
+                (lambda (opt name arg result . rest)
+                  (apply values
+                         (cons (alist-cons 'with-input arg result)
                                rest))))))
 
 (define (show-transformation-options-help)
   (display (_ "
       --with-source=SOURCE
-                         use SOURCE when building the corresponding package")))
+                         use SOURCE when building the corresponding package"))
+  (display (_ "
+      --with-input=PACKAGE=REPLACEMENT
+                         replace dependency PACKAGE by REPLACEMENT")))
 
 
 (define (options->transformation opts)
diff --git a/tests/guix-build.sh b/tests/guix-build.sh
index f7fb3c5..347cdfa 100644
--- a/tests/guix-build.sh
+++ b/tests/guix-build.sh
@@ -1,5 +1,5 @@
 # GNU Guix --- Functional package management for GNU
-# Copyright © 2012, 2013, 2014 Ludovic Courtès <address@hidden>
+# Copyright © 2012, 2013, 2014, 2016 Ludovic Courtès <address@hidden>
 #
 # This file is part of GNU Guix.
 #
@@ -147,6 +147,18 @@ rm -f "$result"
 # Cross building.
 guix build coreutils --target=mips64el-linux-gnu --dry-run --no-substitutes
 
+# Replacements.
+drv1=`guix build guix --with-input=guile=guile-next -d`
+drv2=`guix build guix -d`
+test "$drv1" != "$drv2"
+
+drv1=`guix build guile -d`
+drv2=`guix build guile --with-input=gimp=ruby -d`
+test "$drv1" = "$drv2"
+
+if guix build guile --with-input=libunistring=something-really-silly
+then false; else true; fi
+
 # Parsing package names and versions.
 guix build -n time             # PASS
 guix build -n time-1.7         # PASS, version found
diff --git a/tests/scripts-build.scm b/tests/scripts-build.scm
index 75dc119..94ddaf4 100644
--- a/tests/scripts-build.scm
+++ b/tests/scripts-build.scm
@@ -22,6 +22,9 @@
   #:use-module (guix packages)
   #:use-module (guix scripts build)
   #:use-module (guix ui)
+  #:use-module (gnu packages base)
+  #:use-module (gnu packages busybox)
+  #:use-module (ice-9 match)
   #:use-module (srfi srfi-64))
 
 
@@ -59,6 +62,26 @@
              (string-contains (get-output-string port)
                               "had no effect"))))))
 
+(test-assert "options->transformation, with-input"
+  (let* ((p (dummy-package "guix.scm"
+              (inputs `(("foo" ,coreutils)
+                        ("bar" ,grep)
+                        ("baz" ,(dummy-package "chbouib"
+                                  (native-inputs `(("x" ,grep)))))))))
+         (t (options->transformation '((with-input . "coreutils=busybox")
+                                       (with-input . "grep=findutils")))))
+    (with-store store
+      (let ((new (t store p)))
+        (and (not (eq? new p))
+             (match (package-inputs new)
+               ((("foo" dep1) ("bar" dep2) ("baz" dep3))
+                (and (eq? dep1 busybox)
+                     (eq? dep2 findutils)
+                     (string=? (package-name dep3) "chbouib")
+                     (match (package-native-inputs dep3)
+                       ((("x" dep))
+                        (eq? dep findutils)))))))))))
+
 (test-end)