02/02: guix build: Allow directories to be passed to --with-source.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit a43b55f1a6fa0eb712b2610b86a1775383d3f2cd
Author: Ludovic Courtès <address@hidden>
Date:   Thu Jun 11 11:19:12 2015 +0200

    guix build: Allow directories to be passed to --with-source.
    
    * guix/scripts/build.scm (package-with-source)[tarball-base-name]: 
Gracefully
      handle file names that lack an extension.
      Pass #:recursive? #t to 'download-to-store'.
    * guix/download.scm (download-to-store): Add #:recursive? parameter and pass
      it to 'add-to-store'.
    * doc/guix.texi (Invoking guix build): Add an example of --with-source with 
a
      directory.
---
 doc/guix.texi          |    7 +++++++
 guix/download.scm      |    9 +++++----
 guix/scripts/build.scm |   13 ++++++++++---
 3 files changed, 22 insertions(+), 7 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index be7a292..c70d100 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -3438,6 +3438,13 @@ candidates:
 guix build guile --with-source=../guile-2.0.9.219-e1bb7.tar.xz
 @end example
 
address@hidden or to build from a checkout in a pristine environment:
+
address@hidden
+$ git clone git://git.sv.gnu.org/guix.git
+$ guix build guix --with-source=./guix
address@hidden example
+
 @item --no-grafts
 Do not ``graft'' packages.  In practice, this means that package updates
 available as grafts are not applied.  @xref{Security Updates}, for more
diff --git a/guix/download.scm b/guix/download.scm
index 6b03494..3f7f7ba 100644
--- a/guix/download.scm
+++ b/guix/download.scm
@@ -282,14 +282,15 @@ in the store."
                             )))))
 
 (define* (download-to-store store url #:optional (name (basename url))
-                            #:key (log (current-error-port)))
+                            #:key (log (current-error-port)) recursive?)
   "Download from URL to STORE, either under NAME or URL's basename if
-omitted.  Write progress reports to LOG."
+omitted.  Write progress reports to LOG.  RECURSIVE? has the same effect as
+the same-named parameter of 'add-to-store'."
   (define uri
     (string->uri url))
 
   (if (or (not uri) (memq (uri-scheme uri) '(file #f)))
-      (add-to-store store name #f "sha256"
+      (add-to-store store name recursive? "sha256"
                     (if uri (uri-path uri) url))
       (call-with-temporary-output-file
        (lambda (temp port)
@@ -298,6 +299,6 @@ omitted.  Write progress reports to LOG."
                   (build:url-fetch url temp #:mirrors %mirrors))))
            (close port)
            (and result
-                (add-to-store store name #f "sha256" temp)))))))
+                (add-to-store store name recursive? "sha256" temp)))))))
 
 ;;; download.scm ends here
diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm
index 2307f76..7fd05da 100644
--- a/guix/scripts/build.scm
+++ b/guix/scripts/build.scm
@@ -77,19 +77,26 @@ the new package's version number from URI."
     ;; Return the "base" of FILE-NAME, removing '.tar.gz' or similar
     ;; extensions.
     ;; TODO: Factorize.
-    (cond ((numeric-extension? file-name)
+    (cond ((not (file-extension file-name))
+           file-name)
+          ((numeric-extension? file-name)
            file-name)
           ((string=? (file-extension file-name) "tar")
            (file-sans-extension file-name))
+          ((file-extension file-name)
+           (tarball-base-name (file-sans-extension file-name)))
           (else
-           (tarball-base-name (file-sans-extension file-name)))))
+           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))))))
+
+               ;; Use #:recursive? #t to allow for directories.
+               (source (download-to-store store uri
+                                          #:recursive? #t))))))
 
 
 ;;;