Merge branch 'master' into core-updates

1 files changed, 93 insertions, 36 deletions

diff --git a/guix/derivations.scm b/guix/derivations.scm
index c05644add2..433a8f145e 100644
--- a/guix/derivations.scm
+++ b/guix/derivations.scm
@@ -19,6 +19,7 @@
 (define-module (guix derivations)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-9)
+  #:use-module (srfi srfi-9 gnu)
   #:use-module (srfi srfi-26)
   #:use-module (rnrs io ports)
   #:use-module (rnrs bytevectors)
@@ -36,6 +37,7 @@
             derivation-system
             derivation-builder-arguments
             derivation-builder-environment-vars
+            derivation-file-name
             derivation-prerequisites
             derivation-prerequisites-to-build
 
@@ -56,6 +58,8 @@
 
             read-derivation
             write-derivation
+            derivation->output-path
+            derivation->output-paths
             derivation-path->output-path
             derivation-path->output-paths
             derivation
@@ -64,14 +68,16 @@
             imported-modules
             compiled-modules
             build-expression->derivation
-            imported-files))
+            imported-files)
+  #:replace (build-derivations))
 
 ;;;
 ;;; Nix derivations, as implemented in Nix's `derivations.cc'.
 ;;;
 
 (define-record-type <derivation>
-  (make-derivation outputs inputs sources system builder args env-vars)
+  (make-derivation outputs inputs sources system builder args env-vars
+                   file-name)
   derivation?
   (outputs  derivation-outputs)      ; list of name/<derivation-output> pairs
   (inputs   derivation-inputs)       ; list of <derivation-input>
@@ -79,7 +85,8 @@
   (system   derivation-system)       ; string
   (builder  derivation-builder)      ; store path
   (args     derivation-builder-arguments)         ; list of strings
-  (env-vars derivation-builder-environment-vars)) ; list of name/value pairs
+  (env-vars derivation-builder-environment-vars)  ; list of name/value pairs
+  (file-name derivation-file-name))               ; the .drv file name
 
 (define-record-type <derivation-output>
   (make-derivation-output path hash-algo hash)
@@ -94,6 +101,17 @@
   (path            derivation-input-path)             ; store path
   (sub-derivations derivation-input-sub-derivations)) ; list of strings
 
+(set-record-type-printer! <derivation>
+                          (lambda (drv port)
+                            (format port "#<derivation ~a => ~a ~a>"
+                                    (derivation-file-name drv)
+                                    (string-join
+                                     (map (match-lambda
+                                           ((_ . output)
+                                            (derivation-output-path output)))
+                                          (derivation-outputs drv)))
+                                    (number->string (object-address drv) 16))))
+
 (define (fixed-output-derivation? drv)
   "Return #t if DRV is a fixed-output derivation, such as the result of a
 download with a fixed hash (aka. `fetchurl')."
@@ -262,7 +280,8 @@ that second value is the empty list."
                              (make-input-drvs input-drvs)
                              input-srcs
                              system builder args
-                             (fold-right alist-cons '() var value)))
+                             (fold-right alist-cons '() var value)
+                             (port-filename drv-port)))
            (_
             (error "failed to parse derivation" drv-port result)))))
       ((? (cut eq? <> comma))
@@ -404,25 +423,30 @@ that form."
                  port)
      (display ")" port))))
 
+(define* (derivation->output-path drv #:optional (output "out"))
+  "Return the store path of its output OUTPUT."
+  (let ((outputs (derivation-outputs drv)))
+    (and=> (assoc-ref outputs output) derivation-output-path)))
+
+(define (derivation->output-paths drv)
+  "Return the list of name/path pairs of the outputs of DRV."
+  (map (match-lambda
+        ((name . output)
+         (cons name (derivation-output-path output))))
+       (derivation-outputs drv)))
+
 (define derivation-path->output-path
   ;; This procedure is called frequently, so memoize it.
   (memoize
    (lambda* (path #:optional (output "out"))
      "Read the derivation from PATH (`/nix/store/xxx.drv'), and return the store
 path of its output OUTPUT."
-     (let* ((drv     (call-with-input-file path read-derivation))
-            (outputs (derivation-outputs drv)))
-       (and=> (assoc-ref outputs output) derivation-output-path)))))
+     (derivation->output-path (call-with-input-file path read-derivation)))))
 
 (define (derivation-path->output-paths path)
   "Read the derivation from PATH (`/nix/store/xxx.drv'), and return the
 list of name/path pairs of its outputs."
-  (let* ((drv     (call-with-input-file path read-derivation))
-         (outputs (derivation-outputs drv)))
-    (map (match-lambda
-          ((name . output)
-           (cons name (derivation-output-path output))))
-         outputs)))
+  (derivation->output-paths (call-with-input-file path read-derivation)))
 
 
 ;;;
@@ -470,7 +494,8 @@ in SIZE bytes."
                                (make-derivation-input hash sub-drvs))))
                            inputs))
               (drv    (make-derivation outputs inputs sources
-                                       system builder args env-vars)))
+                                       system builder args env-vars
+                                       #f)))
 
          ;; XXX: At this point this remains faster than `port-sha256', because
          ;; the SHA256 port's `write' method gets called for every single
@@ -505,10 +530,10 @@ the derivation called NAME with hash HASH."
                      (inputs '()) (outputs '("out"))
                      hash hash-algo hash-mode
                      references-graphs)
-  "Build a derivation with the given arguments.  Return the resulting
-store path and <derivation> object.  When HASH, HASH-ALGO, and HASH-MODE
-are given, a fixed-output derivation is created---i.e., one whose result is
-known in advance, such as a file download.
+  "Build a derivation with the given arguments, and return the resulting
+<derivation> object.  When HASH, HASH-ALGO, and HASH-MODE are given, a
+fixed-output derivation is created---i.e., one whose result is known in
+advance, such as a file download.
 
 When REFERENCES-GRAPHS is true, it must be a list of file name/store path
 pairs.  In that case, the reference graph of each store path is exported in
@@ -545,7 +570,8 @@ the build environment in the corresponding file, in a simple text format."
                                        (or (and=> (assoc-ref outputs name)
                                                   derivation-output-path)
                                            value))))
-                               env-vars))))))
+                               env-vars)
+                          #f)))))
 
   (define (user+system-env-vars)
     ;; Some options are passed to the build daemon via the env. vars of
@@ -578,12 +604,26 @@ the build environment in the corresponding file, in a simple text format."
             e
             outputs)))
 
+  (define (set-file-name drv file)
+    ;; Set FILE as the 'file-name' field of DRV.
+    (match drv
+      (($ <derivation> outputs inputs sources system builder
+          args env-vars)
+       (make-derivation outputs inputs sources system builder
+                        args env-vars file))))
+
   (let* ((outputs    (map (lambda (name)
                             ;; Return outputs with an empty path.
                             (cons name
                                   (make-derivation-output "" hash-algo hash)))
                           outputs))
          (inputs     (map (match-lambda
+                           (((? derivation? drv))
+                            (make-derivation-input (derivation-file-name drv)
+                                                   '("out")))
+                           (((? derivation? drv) sub-drvs ...)
+                            (make-derivation-input (derivation-file-name drv)
+                                                   sub-drvs))
                            (((? direct-store-path? input))
                             (make-derivation-input input '("out")))
                            (((? direct-store-path? input) sub-drvs ...)
@@ -604,17 +644,29 @@ the build environment in the corresponding file, in a simple text format."
                                                       (and (not (derivation-path? p))
                                                            p)))
                                                   inputs)
-                                      system builder args env-vars))
+                                      system builder args env-vars #f))
          (drv        (add-output-paths drv-masked)))
 
-    ;; (write-derivation drv-masked (current-error-port))
-    ;; (newline (current-error-port))
-    (values (add-text-to-store store (string-append name ".drv")
-                               (call-with-output-string
-                                (cut write-derivation drv <>))
-                               (map derivation-input-path
-                                    inputs))
-            drv)))
+    (let ((file (add-text-to-store store (string-append name ".drv")
+                                   (call-with-output-string
+                                    (cut write-derivation drv <>))
+                                   (map derivation-input-path
+                                        inputs))))
+      (set-file-name drv file))))
+
+
+;;;
+;;; Store compatibility layer.
+;;;
+
+(define (build-derivations store derivations)
+  "Build DERIVATIONS, a list of <derivation> objects or .drv file names."
+  (let ((build (@ (guix store) build-derivations)))
+    (build store (map (match-lambda
+                       ((? string? file) file)
+                       ((and drv ($ <derivation>))
+                        (derivation-file-name drv)))
+                      derivations))))
 
 
 ;;;
@@ -706,7 +758,7 @@ they can refer to each other."
                                        #:system system
                                        #:guile guile
                                        #:module-path module-path))
-         (module-dir (derivation-path->output-path module-drv))
+         (module-dir (derivation->output-path module-drv))
          (files      (map (lambda (m)
                             (let ((f (string-join (map symbol->string m)
                                                   "/")))
@@ -770,7 +822,7 @@ See the `derivation' procedure for the meaning of REFERENCES-GRAPHS."
     (or guile-for-build (%guile-for-build)))
 
   (define guile
-    (string-append (derivation-path->output-path guile-drv)
+    (string-append (derivation->output-path guile-drv)
                    "/bin/guile"))
 
   (define module-form?
@@ -782,6 +834,8 @@ See the `derivation' procedure for the meaning of REFERENCES-GRAPHS."
     ;; When passed an input that is a source, return its path; otherwise
     ;; return #f.
     (match-lambda
+     ((_ (? derivation?) _ ...)
+      #f)
      ((_ path _ ...)
       (and (not (derivation-path? path))
            path))))
@@ -806,10 +860,13 @@ See the `derivation' procedure for the meaning of REFERENCES-GRAPHS."
                                               (() "out")
                                               ((x) x))))
                                    (cons name
-                                         (if (derivation-path? drv)
-                                             (derivation-path->output-path drv
-                                                                           sub)
-                                             drv)))))
+                                         (cond
+                                          ((derivation? drv)
+                                           (derivation->output-path drv sub))
+                                          ((derivation-path? drv)
+                                           (derivation-path->output-path drv
+                                                                         sub))
+                                          (else drv))))))
                                inputs))
 
                       ,@(if (null? modules)
@@ -854,13 +911,13 @@ See the `derivation' procedure for the meaning of REFERENCES-GRAPHS."
                                           #:guile guile-drv
                                           #:system system)))
          (mod-dir  (and mod-drv
-                        (derivation-path->output-path mod-drv)))
+                        (derivation->output-path mod-drv)))
          (go-drv   (and (pair? modules)
                         (compiled-modules store modules
                                           #:guile guile-drv
                                           #:system system)))
          (go-dir   (and go-drv
-                        (derivation-path->output-path go-drv))))
+                        (derivation->output-path go-drv))))
     (derivation store name guile
                 `("--no-auto-compile"
                   ,@(if mod-dir `("-L" ,mod-dir) '())