Re: [PATCH 2/2] guix: build: Add transitive source building.

Re: [PATCH 2/2] guix: build: Add transitive source building.

[Eric Bavier]

Revisiting this (old) thread...

>Eric Bavier <bavier@member.fsf.org> skribis:
>
>> * guix/scripts/build.scm (%options): Add --sources option.
>>   (package-sources, package-direct-sources)
>>   (package-transitive-sources, package-source-derivations): New
>>   procedures.
>>   (options->derivations)[--sources]: Use them.
>> * doc/guix.texi (Invoking guix build): Document --sources option.
>> * tests/guix-build.sh: Add tests.
>
>[...]
>
>> @item --sources
>> +An extension of the @code{--source} option.  If a package's source is
>
>What about starting with a couple of sentences that better describe what
>it does and what the use case is, like:
>
>  Fetch and return the source of @var{package-or-derivation} and all
>    their dependencies, recursively.  This is a handy way to obtain a
>      local copy of all the source code needed to build @var{packages},
>        allowing you to eventually build them even without network
>    access.

I liked your wording, so I used it ;)

>BTW, what happens when one passes arguments that are not packages?
>Like:
>
>  guix build --sources /gnu/store/...-foo.drv

It behaves in the way 'guix build -S' currently behaves with a
derivation, it just builds the derivation.  It might be interesting if
it examined the derivation and built any sources associated with it, but
that can be a later patch.

>> +  --sources[=TYPE]       build source derivations; TYPE may
>> optionally be one
>> +                         of \"package\", \"all\" (default), or
>> \"transitive\"."))
>
>No period.

Good catch, thanks.

>> +(define (package-sources package)
>
>This procedure appears to be unused (and is awkward anyway ;-)).

Removed.

>> +(define (package-direct-sources package)
>> +  "Return all source origins associated with PACKAGE; including
>> origins in
>> +PACKAGE's inputs."
>> +  `(,@(or (and=> (package-source package) list) '())
>> +    ,@(filter-map (match-lambda
>> +                   ((_ (? origin? orig) _ ...)
>> +                    orig)
>> +                   (_ #f))
>> +                  (package-direct-inputs package))))
>> +
>> +(define (package-transitive-sources package)
>> +  "Return PACKAGE's direct sources, and its input sources,
>> recursively."
>> +  (delete-duplicates
>> +   (concatenate (filter-map (match-lambda
>> +                             ((_ (? origin? orig) _ ...)
>> +                              (list orig))
>> +                             ((_ (? package? p) _ ...)
>> +                              (package-direct-sources p))
>> +                             (_ #f))
>> +                            (bag-transitive-inputs
>> +                             (package->bag package))))))
>
>Perhaps these two could go to (guix packages), with a test in
>tests/packages.scm.

Done in patch [1/2].

>> +# foo.tar.gz
>> +guix build -d -S foo
>> +guix build -d -S foo | grep -e 'foo\.tar\.gz'
>
>Nice tests, thanks for taking the time!

No problem.  I kinda like writing tests. :)


Eric Bavier (2):
  guix: packages: Add package-direct-sources and
    package-transitive-sources.
  guix: build: Add transitive source building.

 doc/guix.texi          |   43 +++++++++++++++++++++++++
 guix/packages.scm      |   24 ++++++++++++++
 guix/scripts/build.scm |   55 +++++++++++++++++++++----------
 guix/tests.scm         |   10 +++++-
 tests/guix-build.sh    |   82 ++++++++++++++++++++++++++++++++++++++++++++++++
 tests/packages.scm     |   30 +++++++++++++++++
 6 files changed, 226 insertions(+), 18 deletions(-)

-- 
1.7.9.5

[PATCH 1/2] guix: packages: Add package-direct-sources and package-transitive-sources.

[Eric Bavier]

* guix/tests.scm (dummy-origin): New syntax.
* guix/packages.scm (package-direct-sources)
  (package-transitive-sources): New procedures.
* tests/packages.scm: Test them.
---
 guix/packages.scm  |   24 ++++++++++++++++++++++++
 guix/tests.scm     |   10 +++++++++-
 tests/packages.scm |   30 ++++++++++++++++++++++++++++++
 3 files changed, 63 insertions(+), 1 deletion(-)

diff --git a/guix/packages.scm b/guix/packages.scm
index fde46d5..ff0a466 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -82,6 +82,8 @@
             package-location
             package-field-location
 
+            package-direct-sources
+            package-transitive-sources
             package-direct-inputs
             package-transitive-inputs
             package-transitive-target-inputs
@@ -519,6 +521,28 @@ IMPORTED-MODULES specify modules to use/import for use by SNIPPET."
       ((input rest ...)
        (loop rest (cons input result))))))
 
+(define (package-direct-sources package)
+  "Return all source origins associated with PACKAGE; including origins in
+PACKAGE's inputs."
+  `(,@(or (and=> (package-source package) list) '())
+    ,@(filter-map (match-lambda
+                   ((_ (? origin? orig) _ ...)
+                    orig)
+                   (_ #f))
+                  (package-direct-inputs package))))
+
+(define (package-transitive-sources package)
+  "Return PACKAGE's direct sources, and their direct sources, recursively."
+  (delete-duplicates
+   (concatenate (filter-map (match-lambda
+                             ((_ (? origin? orig) _ ...)
+                              (list orig))
+                             ((_ (? package? p) _ ...)
+                              (package-direct-sources p))
+                             (_ #f))
+                            (bag-transitive-inputs
+                             (package->bag package))))))
+
 (define (package-direct-inputs package)
   "Return all the direct inputs of PACKAGE---i.e, its direct inputs along
 with their propagated inputs."
diff --git a/guix/tests.scm b/guix/tests.scm
index 080ee9c..87e6cc2 100644
--- a/guix/tests.scm
+++ b/guix/tests.scm
@@ -37,7 +37,8 @@
             %substitute-directory
             with-derivation-narinfo
             with-derivation-substitute
-            dummy-package))
+            dummy-package
+            dummy-origin))
 
 ;;; Commentary:
 ;;;
@@ -219,6 +220,13 @@ initialized with default values, and with EXTRA-FIELDS set as specified."
            (synopsis #f) (description #f)
            (home-page #f) (license #f)))
 
+(define-syntax-rule (dummy-origin extra-fields ...)
+  "Return a \"dummy\" origin, with all its compulsory fields initialized with
+default values, and with EXTRA-FIELDS set as specified."
+  (origin extra-fields ...
+          (method #f) (uri "http://www.example.com")
+          (sha256 (base32 (make-string 52 #\x)))))
+
 ;; Local Variables:
 ;; eval: (put 'call-with-derivation-narinfo 'scheme-indent-function 1)
 ;; eval: (put 'call-with-derivation-substitute 'scheme-indent-function 2)
diff --git a/tests/packages.scm b/tests/packages.scm
index 9191032..c1bd697 100644
--- a/tests/packages.scm
+++ b/tests/packages.scm
@@ -155,6 +155,36 @@
           (package-transitive-supported-systems d)
           (package-transitive-supported-systems e))))
 
+(let* ((o (dummy-origin))
+       (u (dummy-origin))
+       (i (dummy-origin))
+       (a (dummy-package "a"))
+       (b (dummy-package "b"
+            (inputs `(("a" ,a) ("i" ,i)))))
+       (c (package (inherit b) (source o)))
+       (d (dummy-package "d"
+            (build-system trivial-build-system)
+            (source u) (inputs `(("c" ,c))))))
+  (test-assert "package-direct-sources, no source"
+    (null? (package-direct-sources a)))
+  (test-equal "package-direct-sources, #f source"
+    (list i)
+    (package-direct-sources b))
+  (test-equal "package-direct-sources, not input source"
+    (list u)
+    (package-direct-sources d))
+  (test-assert "package-direct-sources"
+    (let ((s (package-direct-sources c)))
+      (and (= (length (pk 's-sources s)) 2)
+           (member o s)
+           (member i s))))
+  (test-assert "package-transitive-sources"
+    (let ((s (package-transitive-sources d)))
+      (and (= (length (pk 'd-sources s)) 3)
+           (member o s)
+           (member i s)
+           (member u s)))))
+
 (test-equal "package-transitive-supported-systems, implicit inputs"
   %supported-systems
 
-- 
1.7.9.5

[PATCH 2/2] guix: build: Add transitive source building.

[Eric Bavier]

* guix/scripts/build.scm (%options, options->derivations): Add --sources
  option.
* doc/guix.texi (Invoking guix build): Document --sources option.
* tests/guix-build.sh: Add tests.
---
 doc/guix.texi          |   43 +++++++++++++++++++++++++
 guix/scripts/build.scm |   55 ++++++++++++++++++++++----------
 tests/guix-build.sh    |   82 ++++++++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 163 insertions(+), 17 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 4269d4f..6636792 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -2924,6 +2924,49 @@ The returned source tarball is the result of applying any patches and
 code snippets specified in the package's @code{origin} (@pxref{Defining
 Packages}).
 
+@item --sources
+Fetch and return the source of @var{package-or-derivation} and all their
+dependencies, recursively.  This is a handy way to obtain a local copy
+of all the source code needed to build @var{packages}, allowing you to
+eventually build them even without network access.  It is an extension
+of the @code{--source} option and can accept one of the following
+optional argument values:
+
+@table @code
+@item package
+This value causes the @code{--sources} option to behave in the same way
+as the @code{--source} option.
+
+@item all
+Build all packages' source derivations, including any source that might
+be listed as @code{inputs}.  This is the default value.
+
+@example
+$ guix build --sources tzdata
+The following derivations will be built:
+   /gnu/store/@dots{}-tzdata2015b.tar.gz.drv
+   /gnu/store/@dots{}-tzcode2015b.tar.gz.drv
+@end example
+
+@item transitive
+Build all packages' source derivations, as well as all source
+derivations for packages' transitive inputs.  This can be used e.g. to
+prefetch package source for later offline building.
+
+@example
+$ guix build --sources=transitive tzdata
+The following derivations will be built:
+   /gnu/store/@dots{}-tzcode2015b.tar.gz.drv
+   /gnu/store/@dots{}-findutils-4.4.2.tar.xz.drv
+   /gnu/store/@dots{}-grep-2.21.tar.xz.drv
+   /gnu/store/@dots{}-coreutils-8.23.tar.xz.drv
+   /gnu/store/@dots{}-make-4.1.tar.xz.drv
+   /gnu/store/@dots{}-bash-4.3.tar.xz.drv
+@dots{}
+@end example
+
+@end table
+
 @item --system=@var{system}
 @itemx -s @var{system}
 Attempt to build for @var{system}---e.g., @code{i686-linux}---instead of
diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm
index 370c2a3..9366ab6 100644
--- a/guix/scripts/build.scm
+++ b/guix/scripts/build.scm
@@ -228,6 +228,9 @@ Build the given PACKAGE-OR-DERIVATION and return their output paths.\n"))
   (display (_ "
   -S, --source           build the packages' source derivations"))
   (display (_ "
+  --sources[=TYPE]       build source derivations; TYPE may optionally be one
+                         of \"package\", \"all\" (default), or \"transitive\""))
+  (display (_ "
   -s, --system=SYSTEM    attempt to build for SYSTEM--e.g., \"i686-linux\""))
   (display (_ "
       --target=TRIPLET   cross-build for TRIPLET--e.g., \"armel-linux-gnu\""))
@@ -262,10 +265,22 @@ Build the given PACKAGE-OR-DERIVATION and return their output paths.\n"))
          (option '(#\V "version") #f #f
                  (lambda args
                    (show-version-and-exit "guix build")))
-
          (option '(#\S "source") #f #f
                  (lambda (opt name arg result)
-                   (alist-cons 'source? #t result)))
+                   (alist-cons 'source #t result)))
+         (option '("sources") #f #t
+                 (lambda (opt name arg result)
+                   (match arg
+                     ("package"
+                      (alist-cons 'source #t result))
+                     ((or "all" #f)
+                      (alist-cons 'source package-direct-sources result))
+                     ("transitive"
+                      (alist-cons 'source package-transitive-sources result))
+                     (else
+                      (leave (_ "invalid argument: '~a' option argument: ~a, ~
+must be one of 'package', 'all', or 'transitive'~%")
+                             name arg)))))
          (option '(#\s "system") #t #f
                  (lambda (opt name arg result)
                    (alist-cons 'system arg
@@ -308,28 +323,34 @@ build."
       (triplet
        (cut package-cross-derivation <> <> triplet <>))))
 
-  (define src?   (assoc-ref opts 'source?))
+  (define src    (assoc-ref opts 'source))
   (define sys    (assoc-ref opts 'system))
   (define graft? (assoc-ref opts 'graft?))
 
   (parameterize ((%graft? graft?))
     (let ((opts (options/with-source store
                                      (options/resolve-packages store opts))))
-      (filter-map (match-lambda
-                   (('argument . (? package? p))
-                    (if src?
+      (concatenate
+       (filter-map (match-lambda
+                    (('argument . (? package? p))
+                     (match src
+                       (#f
+                        (list (package->derivation store p sys)))
+                       (#t
                         (let ((s (package-source p)))
-                          (package-source-derivation store s))
-                        (package->derivation store p sys)))
-                   (('argument . (? derivation? drv))
-                    drv)
-                   (('argument . (? derivation-path? drv))
-                    (call-with-input-file drv read-derivation))
-                   (('argument . (? store-path?))
-                    ;; Nothing to do; maybe for --log-file.
-                    #f)
-                   (_ #f))
-                  opts))))
+                          (list (package-source-derivation store s))))
+                       (proc
+                        (map (cut package-source-derivation store <>)
+                             (proc p)))))
+                    (('argument . (? derivation? drv))
+                     (list drv))
+                    (('argument . (? derivation-path? drv))
+                     (list (call-with-input-file drv read-derivation)))
+                    (('argument . (? store-path?))
+                     ;; Nothing to do; maybe for --log-file.
+                     #f)
+                    (_ #f))
+                   opts)))))
 
 (define (options/resolve-packages store opts)
   "Return OPTS with package specification strings replaced by actual
diff --git a/tests/guix-build.sh b/tests/guix-build.sh
index 836c45e..a72ce09 100644
--- a/tests/guix-build.sh
+++ b/tests/guix-build.sh
@@ -36,6 +36,88 @@ guix build -e '(@@ (gnu packages bootstrap) %bootstrap-guile)' |	\
 guix build hello -d |				\
     grep -e '-hello-[0-9\.]\+\.drv$'
 
+# Check --sources option with its arguments
+module_dir="t-guix-build-$$"
+mkdir "$module_dir"
+trap "rm -rf $module_dir" EXIT
+
+cat > "$module_dir/foo.scm"<<EOF
+(define-module (foo)
+  #:use-module (guix packages)
+  #:use-module (guix download)
+  #:use-module (guix build-system trivial))
+
+(define-public foo
+  (package
+    (name "foo")
+    (version "42")
+    (source (origin
+              (method url-fetch)
+              (uri "http://www.example.com/foo.tar.gz")
+              (sha256
+               (base32
+                "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"))))
+    (build-system trivial-build-system)
+    (inputs
+     (quasiquote (("bar" ,bar))))
+    (home-page "www.example.com")
+    (synopsis "Dummy package")
+    (description "foo is a dummy package for testing.")
+    (license #f)))
+
+(define-public bar
+  (package
+    (name "bar")
+    (version "9001")
+    (source (origin
+              (method url-fetch)
+              (uri "http://www.example.com/bar.tar.gz")
+              (sha256
+               (base32
+                "yyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyy"))))
+    (build-system trivial-build-system)
+    (inputs
+     (quasiquote
+      (("data" ,(origin
+                 (method url-fetch)
+                 (uri "http://www.example.com/bar.dat")
+                 (sha256
+                  (base32
+                   "zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz")))))))
+    (home-page "www.example.com")
+    (synopsis "Dummy package")
+    (description "bar is a dummy package for testing.")
+    (license #f)))
+EOF
+
+GUIX_PACKAGE_PATH="$module_dir"
+export GUIX_PACKAGE_PATH
+
+# foo.tar.gz
+guix build -d -S foo
+guix build -d -S foo | grep -e 'foo\.tar\.gz'
+
+guix build -d --sources=package foo
+guix build -d --sources=package foo | grep -e 'foo\.tar\.gz'
+
+# bar.tar.gz and bar.dat
+guix build -d --sources bar
+test `guix build -d --sources bar \
+      | grep -e 'bar\.tar\.gz' -e 'bar\.dat' \
+      | wc -l` -eq 2
+
+# bar.tar.gz and bar.dat
+guix build -d --sources=all bar
+test `guix build -d --sources bar \
+      | grep -e 'bar\.tar\.gz' -e 'bar\.dat' \
+      | wc -l` -eq 2
+
+# Should include foo.tar.gz, bar.tar.gz, and bar.dat
+guix build -d --sources=transitive foo
+test `guix build -d --sources=transitive foo \
+      | grep -e 'foo\.tar\.gz' -e 'bar\.tar\.gz' -e 'bar\.dat' \
+      | wc -l` -eq 3
+
 # Should all return valid log files.
 drv="`guix build -d -e '(@@ (gnu packages bootstrap) %bootstrap-guile)'`"
 out="`guix build -e '(@@ (gnu packages bootstrap) %bootstrap-guile)'`"
-- 
1.7.9.5

Re: [PATCH 1/2] guix: packages: Add package-direct-sources and package-transitive-sources.

[Ludovic Courtès]

Eric Bavier <bavier@member.fsf.org> skribis:

> * guix/tests.scm (dummy-origin): New syntax.
> * guix/packages.scm (package-direct-sources)
>   (package-transitive-sources): New procedures.
> * tests/packages.scm: Test them.

Could you list the names of the tests for tests/packages.scm?

Otherwise LGTM, thanks!

Ludo’.

Re: [PATCH 2/2] guix: build: Add transitive source building.

[Ludovic Courtès]

Eric Bavier <bavier@member.fsf.org> skribis:

> * guix/scripts/build.scm (%options, options->derivations): Add --sources
>   option.
> * doc/guix.texi (Invoking guix build): Document --sources option.
> * tests/guix-build.sh: Add tests.

LGTM!

Thank you for reviving these patches!

Ludo’.