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

[Eric Bavier <ericbavier@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 950 bytes --]

Hello Guix,

This patch is intended mostly for discussion.  It was brought up again
on IRC yesterday the idea of prefetching package source into the store
in order to be able to hack on guix offline.

A naive approach such as running `guix build -S` on each entry of `guix
package --list-available` isn't enough because of build-system-implicit
inputs and package origin inputs, as well as non-public bootstrapping
source.

This patch changes the semantics of `guix build --source` so that it
takes an optional argument, one of 'package', 'all' (default), or
'transitive'.  `guix build --source=package foo` will build the source
derivations for foo's source origin, which is the current behavior.
`guix build --source=all foo` will build all of foo's origin's,
including any which might be in its inputs (e.g. texlive's
texmf-extra-src input).  `guix build --source=transitive foo` will build
the source origins for all of foo's transitive inputs.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-guix-build-Add-transitive-source-building.patch --]
[-- Type: text/x-diff, Size: 5320 bytes --]

From 81d161e418753ce2d136ea901cc28b11cee26314 Mon Sep 17 00:00:00 2001
From: Eric Bavier <bavier@member.fsf.org>
Date: Wed, 28 Jan 2015 13:33:28 -0600
Subject: [PATCH] guix: build: Add transitive source building.

* guix/scripts/build.scm [--source]: Add optional arguments 'package',
  'all', and 'transitive'.
  (package-source*, package-direct-source, package-transitive-source):
  New procedures.
  (options->derivations)[--source]: Use them.
---
 guix/scripts/build.scm |   78 ++++++++++++++++++++++++++++++++++++------------
 1 file changed, 59 insertions(+), 19 deletions(-)

diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm
index 07ced30..8a422fe 100644
--- a/guix/scripts/build.scm
+++ b/guix/scripts/build.scm
@@ -262,10 +262,21 @@ 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
+         (option '(#\S "source") #f #t
                  (lambda (opt name arg result)
-                   (alist-cons 'source? #t result)))
+                   (match arg
+                     ("package"
+                      (alist-cons 'source package-source* result))
+                     ("all"
+                      (alist-cons 'source package-direct-source result))
+                     ("transitive"
+                      (alist-cons 'source package-transitive-source result))
+                     (#f
+                      (alist-cons 'source package-source* 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
@@ -299,6 +310,32 @@ Build the given PACKAGE-OR-DERIVATION and return their output paths.\n"))
 
          %standard-build-options))
 
+(define (package-source* package)
+  "List package-source but returns its results as a list"
+  (list (package-source package)))
+
+(define (package-direct-source 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-source 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-source p))
+                             (_ #f))
+                            (bag-transitive-inputs
+                             (package->bag package))))))
+
 (define (options->derivations store opts)
   "Given OPTS, the result of 'args-fold', return a list of derivations to
 build."
@@ -308,28 +345,31 @@ 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?
-                        (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))))
+      (concatenate
+       (filter-map (match-lambda
+                    (('argument . (? package? p))
+                     (match src
+                       (#f
+                        (list (package->derivation store p sys)))
+                       (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
-- 
1.7.9.5


[-- Attachment #3: Type: text/plain, Size: 885 bytes --]


Obviously all this would need to be documented before actually
apply such a patch. 

I've tested this patch by building e.g. gmsh (which I did not already
have in the store)::

  $ guix build --source=transitive gmsh
  [...]
  <disconnect network>
  $ guix build gmsh

The build succeeded after building the glu, glproto, fltk, and
xf86vidmodeproto inputs from source.  I haven't yet tried making a
change that would require rebootstrapping while offline.  I think the
idea is that this should work.

What I'd like to get some feedback on:

1. Adding an optional argument to `guix build --source` currently breaks
   `guix build -S foo`, since the option parsing thinks "foo" is the
   argument for -S.  I'm not sure how this could be reconciled.

2. There might be clearer user/developer-facing names for the arguments.

3. Am I understanding the use-case?

Thanks,

-- 
Eric Bavier