[bug#34838] [PATCH 1/6] guix build: Add '--with-git-url'.

[Ludovic Courtès]

From: Ludovic Courtès <address@hidden>

* guix/scripts/build.scm (%not-equal): New variable.
(evaluate-git-replacement-specs): Use it instead of local variable
'not-equal'.
(transform-package-source-git-url): New procedure.
(%transformations): Add 'with-git-url'.
(%transformation-options, show-transformation-options-help): Add
'--with-git-url'.
* tests/scripts-build.scm ("options->transformation, with-git-url"):
New test.
---
 doc/guix.texi           | 36 ++++++++++++++++++++-----------
 guix/scripts/build.scm  | 47 +++++++++++++++++++++++++++++++++++------
 tests/scripts-build.scm | 24 ++++++++++++++++++++-
 3 files changed, 87 insertions(+), 20 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 82cf2babb2..42885577be 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -7694,9 +7694,32 @@ must be compatible.  If @var{replacement} is somehow 
incompatible with
 @var{package}, then the resulting package may be unusable.  Use with
 care!
 
address@hidden address@hidden@var{branch}
address@hidden address@hidden@var{url}
 @cindex Git, using the latest commit
 @cindex latest commit, building
+Build @var{package} from the latest commit of the @code{master} branch of the
+Git repository at @var{url}.
+
+For example, the following commands builds the GNU C Library (glibc) straight
+from its Git repository instead of building the currently-packaged release:
+
address@hidden
+guix build glibc \
+  --with-git-url=glibc=git://sourceware.org/git/glibc.git
address@hidden example
+
address@hidden continuous integration
+Obviously, since it uses the latest commit of the given branch, the result of
+such a command varies over time.  Nevertheless it is a convenient way to
+rebuild entire software stacks against the latest commit of one or more
+packages.  This is particularly useful in the context of continuous
+integration (CI).
+
+Checkouts are kept in a cache under @file{~/.cache/guix/checkouts} to speed up
+consecutive accesses to the same repository.  You may want to clean it up once
+in a while to save disk space.
+
address@hidden address@hidden@var{branch}
 Build @var{package} from the latest commit of @var{branch}.  The @code{source}
 field of @var{package} must be an origin with the @code{git-fetch} method
 (@pxref{origin Reference}) or a @code{git-checkout} object; the repository URL
@@ -7712,17 +7735,6 @@ specific @code{guile-sqlite3} build:
 guix build --with-branch=guile-sqlite3=master cuirass
 @end example
 
address@hidden continuous integration
-Obviously, since it uses the latest commit of the given branch, the result of
-such a command varies over time.  Nevertheless it is a convenient way to
-rebuild entire software stacks against the latest commit of one or more
-packages.  This is particularly useful in the context of continuous
-integration (CI).
-
-Checkouts are kept in a cache under @file{~/.cache/guix/checkouts} to speed up
-consecutive accesses to the same repository.  You may want to clean it up once
-in a while to save disk space.
-
 @item address@hidden@var{commit}
 This is similar to @code{--with-branch}, except that it builds from
 @var{commit} rather than the tip of a branch.  @var{commit} must be a valid
diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm
index 6b29c470fb..5883dbfb44 100644
--- a/guix/scripts/build.scm
+++ b/guix/scripts/build.scm
@@ -272,16 +272,16 @@ current 'gnutls' package, after which version 3.5.4 is 
grafted onto them."
           (rewrite obj)
           obj))))
 
+(define %not-equal
+  (char-set-complement (char-set #\=)))
+
 (define (evaluate-git-replacement-specs specs proc)
   "Parse SPECS, a list of strings like \"guile=stable-2.2\", and return a list
 of package pairs, where (PROC PACKAGE URL BRANCH-OR-COMMIT) returns the
 replacement package.  Raise an error if an element of SPECS uses invalid
 syntax, or if a package it refers to could not be found."
-  (define not-equal
-    (char-set-complement (char-set #\=)))
-
   (map (lambda (spec)
-         (match (string-tokenize spec not-equal)
+         (match (string-tokenize spec %not-equal)
            ((name branch-or-commit)
             (let* ((old    (specification->package name))
                    (source (package-source old))
@@ -341,6 +341,33 @@ strings like \"guile-next=cabba9e\" meaning that packages 
are built using
           (rewrite obj)
           obj))))
 
+(define (transform-package-source-git-url replacement-specs)
+  "Return a procedure that, when passed a package, replaces its dependencies
+according to REPLACEMENT-SPECS.  REPLACEMENT-SPECS is a list of strings like
+\"guile-json=https://gitthing.com/…\"; meaning that packages are built using
+a checkout of the Git repository at the given URL."
+  ;; FIXME: Currently this cannot be combined with '--with-branch' or
+  ;; '--with-commit' because they all transform "from scratch".
+  (define replacements
+    (map (lambda (spec)
+           (match (string-tokenize spec %not-equal)
+             ((name url)
+              (let* ((old (specification->package name))
+                     (new (package
+                            (inherit old)
+                            (source (git-checkout (url url)
+                                                  (recursive? #t))))))
+                (cons old new)))))
+         replacement-specs))
+
+  (define rewrite
+    (package-input-rewriting replacements))
+
+  (lambda (store obj)
+    (if (package? obj)
+        (rewrite 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
@@ -350,7 +377,8 @@ strings like \"guile-next=cabba9e\" meaning that packages 
are built using
     (with-input  . ,transform-package-inputs)
     (with-graft  . ,transform-package-inputs/graft)
     (with-branch . ,transform-package-source-branch)
-    (with-commit . ,transform-package-source-commit)))
+    (with-commit . ,transform-package-source-commit)
+    (with-git-url . ,transform-package-source-git-url)))
 
 (define %transformation-options
   ;; The command-line interface to the above transformations.
@@ -368,7 +396,9 @@ strings like \"guile-next=cabba9e\" meaning that packages 
are built using
           (option '("with-branch") #t #f
                   (parser 'with-branch))
           (option '("with-commit") #t #f
-                  (parser 'with-commit)))))
+                  (parser 'with-commit))
+          (option '("with-git-url") #t #f
+                  (parser 'with-git-url)))))
 
 (define (show-transformation-options-help)
   (display (G_ "
@@ -385,7 +415,10 @@ strings like \"guile-next=cabba9e\" meaning that packages 
are built using
                          build PACKAGE from the latest commit of BRANCH"))
   (display (G_ "
       --with-commit=PACKAGE=COMMIT
-                         build PACKAGE from COMMIT")))
+                         build PACKAGE from COMMIT"))
+  (display (G_ "
+      --with-git-url=PACKAGE=URL
+                         build PACKAGE from the repository at URL")))
 
 
 (define (options->transformation opts)
diff --git a/tests/scripts-build.scm b/tests/scripts-build.scm
index 190426ed06..54681274b9 100644
--- a/tests/scripts-build.scm
+++ b/tests/scripts-build.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2016, 2017 Ludovic Courtès <address@hidden>
+;;; Copyright © 2016, 2017, 2019 Ludovic Courtès <address@hidden>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -23,6 +23,7 @@
   #:use-module (guix scripts build)
   #:use-module (guix ui)
   #:use-module (guix utils)
+  #:use-module (guix git)
   #:use-module (gnu packages)
   #:use-module (gnu packages base)
   #:use-module (gnu packages busybox)
@@ -164,4 +165,25 @@
                        ((("x" dep))
                         (eq? (package-replacement dep) findutils)))))))))))
 
+(test-equal "options->transformation, with-git-url"
+  (let ((source (git-checkout (url "https://example.org";)
+                              (recursive? #t))))
+    (list source source))
+  (let* ((p (dummy-package "guix.scm"
+              (inputs `(("foo" ,grep)
+                        ("bar" ,(dummy-package "chbouib"
+                                  (native-inputs `(("x" ,grep)))))))))
+         (t (options->transformation '((with-git-url . 
"grep=https://example.org";)))))
+    (with-store store
+      (let ((new (t store p)))
+        (and (not (eq? new p))
+             (match (package-inputs new)
+               ((("foo" dep1) ("bar" dep2))
+                (and (string=? (package-full-name dep1)
+                               (package-full-name grep))
+                     (string=? (package-name dep2) "chbouib")
+                     (match (package-native-inputs dep2)
+                       ((("x" dep3))
+                        (map package-source (list dep1 dep3))))))))))))
+
 (test-end)
-- 
2.21.0