unofficial mirror of guix-patches@gnu.org 
 help / color / mirror / code / Atom feed
* [bug#36351] [PATCH 00/10] Add 'derivation-build-plan', improve (guix derivations)
@ 2019-06-24 12:18 Ludovic Courtès
  2019-06-24 12:22 ` [bug#36351] [PATCH 01/10] derivations: Add 'derivation-input' Ludovic Courtès
  2019-06-27  9:17 ` bug#36351: [PATCH 00/10] Add 'derivation-build-plan', improve (guix derivations) Ludovic Courtès
  0 siblings, 2 replies; 12+ messages in thread
From: Ludovic Courtès @ 2019-06-24 12:18 UTC (permalink / raw)
  To: 36351

Hello Guix,

This is the season cleanup of (guix derivations)!

The initial motivation was to allow ‘show-what-to-build’ to do deal
with builds of single derivation outputs, which became possible in
commit f8a9f99cd602ce1dc5307cb0c21ae718ad8796bb.

I ended up replacing ‘derivation-prerequisites-to-build’ with
‘derivation-build-plan’, which is both more flexible and simpler.

That led me to change <derivation-input> so that it would contain
a <derivation> instead of a derivation file name, which is more
natural and helps for things like ‘derivation-build-plan’ that
traverse the derivation graph (previously it’d have to call
‘read-derivation-from-file’, which would look up the derivation
in ‘%derivation-cache’.)

I wanted to change ‘guix build’ to support things like:

  guix build groff:doc

but there are slight complications so I’ll punt on that for now.

Thoughts?

Ludo’.

Ludovic Courtès (10):
  derivations: Add 'derivation-input'.
  derivations: Rewrite and replace 'derivations-prerequisites-to-build'.
  ui: 'show-what-to-build' uses 'derivation-build-plan'.
  graph: Use 'derivation-input-derivation'.
  derivations: <derivation-input> now aggregates a <derivation>.
  derivations: 'derivation' preserves pointer equality.
  derivations: 'build-derivations' can be passed derivation inputs.
  packages: 'specification->package+output' distinguishes "no output
    specified".
  ui: 'show-what-to-build' accepts derivation inputs.
  ui: 'show-derivation-outputs' accepts <derivation-input> records.

 gnu/packages.scm       |   8 +-
 guix/derivations.scm   | 269 +++++++++++++++++++++++------------------
 guix/scripts/graph.scm |   3 +-
 guix/ui.scm            |  67 +++++-----
 tests/derivations.scm  |  80 ++++++------
 tests/grafts.scm       |  16 +--
 tests/packages.scm     |  32 +++++
 7 files changed, 271 insertions(+), 204 deletions(-)

-- 
2.22.0

^ permalink raw reply	[flat|nested] 12+ messages in thread

* [bug#36351] [PATCH 01/10] derivations: Add 'derivation-input'.
  2019-06-24 12:18 [bug#36351] [PATCH 00/10] Add 'derivation-build-plan', improve (guix derivations) Ludovic Courtès
@ 2019-06-24 12:22 ` Ludovic Courtès
  2019-06-24 12:22   ` [bug#36351] [PATCH 02/10] derivations: Rewrite and replace 'derivations-prerequisites-to-build' Ludovic Courtès
                     ` (8 more replies)
  2019-06-27  9:17 ` bug#36351: [PATCH 00/10] Add 'derivation-build-plan', improve (guix derivations) Ludovic Courtès
  1 sibling, 9 replies; 12+ messages in thread
From: Ludovic Courtès @ 2019-06-24 12:22 UTC (permalink / raw)
  To: 36351

* guix/derivations.scm (derivation-input): New procedure.
* tests/grafts.scm (make-derivation-input): Remove.
("graft-derivation, unused outputs not depended on"): Use
'derivation-input'.
---
 guix/derivations.scm |  8 ++++++++
 tests/grafts.scm     | 16 ++++------------
 2 files changed, 12 insertions(+), 12 deletions(-)

diff --git a/guix/derivations.scm b/guix/derivations.scm
index 8145d51143..4df7b06181 100644
--- a/guix/derivations.scm
+++ b/guix/derivations.scm
@@ -157,6 +157,14 @@
   "Return the <derivation> object INPUT refers to."
   (read-derivation-from-file (derivation-input-path input)))
 
+(define* (derivation-input drv #:optional
+                           (outputs (derivation-output-names drv)))
+  "Return a <derivation-input> for the OUTPUTS of DRV."
+  ;; This is a public interface meant to be more convenient than
+  ;; 'make-derivation-input' and giving us more control.
+  (make-derivation-input (derivation-file-name drv)
+                         outputs))
+
 (set-record-type-printer! <derivation>
                           (lambda (drv port)
                             (format port "#<derivation ~a => ~a ~a>"
diff --git a/tests/grafts.scm b/tests/grafts.scm
index f85f3c6913..6fd3d5e171 100644
--- a/tests/grafts.scm
+++ b/tests/grafts.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -45,9 +45,6 @@
 (define %mkdir
   (bootstrap-binary "mkdir"))
 
-(define make-derivation-input
-  (@@ (guix derivations) make-derivation-input))
-
 \f
 (test-begin "grafts")
 
@@ -356,16 +353,11 @@
                 (p1r-inputs  (filter (match-input p1r) inputs))
                 (p2-inputs   (filter (match-input p2) inputs)))
            (and (equal? p1-inputs
-                        (list (make-derivation-input (derivation-file-name p1)
-                                                     '("one"))))
+                        (list (derivation-input p1 '("one"))))
                 (equal? p1r-inputs
-                        (list
-                         (make-derivation-input (derivation-file-name p1r)
-                                                '("ONE"))))
+                        (list (derivation-input p1r '("ONE"))))
                 (equal? p2-inputs
-                        (list
-                         (make-derivation-input (derivation-file-name p2)
-                                                '("aaa"))))
+                        (list (derivation-input p2 '("aaa"))))
                 (derivation-output-names p2g))))))
 
 (test-assert "graft-derivation, renaming"         ;<http://bugs.gnu.org/23132>
-- 
2.22.0

^ permalink raw reply related	[flat|nested] 12+ messages in thread

* [bug#36351] [PATCH 02/10] derivations: Rewrite and replace 'derivations-prerequisites-to-build'.
  2019-06-24 12:22 ` [bug#36351] [PATCH 01/10] derivations: Add 'derivation-input' Ludovic Courtès
@ 2019-06-24 12:22   ` Ludovic Courtès
  2019-06-24 12:22   ` [bug#36351] [PATCH 03/10] ui: 'show-what-to-build' uses 'derivation-build-plan' Ludovic Courtès
                     ` (7 subsequent siblings)
  8 siblings, 0 replies; 12+ messages in thread
From: Ludovic Courtès @ 2019-06-24 12:22 UTC (permalink / raw)
  To: 36351

The new 'derivation-build-plan' procedure has a more appropriate
signature: it takes a list of <derivation-inputs> instead of taking one
<derivation>.  Its body is also much simpler.

* guix/derivations.scm (derivation-build-plan): New procedure.
(derivation-prerequisites-to-build): Express in terms of
'derivation-build-plan' and mark as deprecated.
* tests/derivations.scm: Change 'derivation-prerequisites-to-build'
tests to 'derivation-build-plan' and adjust accordingly.
---
 guix/derivations.scm  | 132 ++++++++++++++++++++----------------------
 tests/derivations.scm |  63 +++++++++++---------
 2 files changed, 97 insertions(+), 98 deletions(-)

diff --git a/guix/derivations.scm b/guix/derivations.scm
index 4df7b06181..f6e94694fd 100644
--- a/guix/derivations.scm
+++ b/guix/derivations.scm
@@ -21,6 +21,7 @@
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-9)
   #:use-module (srfi srfi-9 gnu)
+  #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-34)
   #:use-module (srfi srfi-35)
@@ -34,6 +35,7 @@
   #:use-module (guix base16)
   #:use-module (guix memoization)
   #:use-module (guix combinators)
+  #:use-module (guix deprecation)
   #:use-module (guix monads)
   #:use-module (gcrypt hash)
   #:use-module (guix base32)
@@ -50,7 +52,8 @@
             derivation-builder-environment-vars
             derivation-file-name
             derivation-prerequisites
-            derivation-prerequisites-to-build
+            derivation-build-plan
+            derivation-prerequisites-to-build     ;deprecated
 
             <derivation-output>
             derivation-output?
@@ -61,6 +64,7 @@
 
             <derivation-input>
             derivation-input?
+            derivation-input
             derivation-input-path
             derivation-input-derivation
             derivation-input-sub-derivations
@@ -341,82 +345,70 @@ substituter many times."
         (#f #f)
         ((key . value) value)))))
 
-(define* (derivation-prerequisites-to-build store drv
-                                            #:key
-                                            (mode (build-mode normal))
-                                            (outputs
-                                             (derivation-output-names drv))
-                                            (substitutable-info
-                                             (substitution-oracle store
-                                                                  (list drv)
-                                                                  #:mode mode)))
-  "Return two values: the list of derivation-inputs required to build the
-OUTPUTS of DRV and not already available in STORE, recursively, and the list
-of required store paths that can be substituted.  SUBSTITUTABLE-INFO must be a
-one-argument procedure similar to that returned by 'substitution-oracle'."
-  (define built?
-    (mlambda (item)
-      (valid-path? store item)))
+(define* (derivation-build-plan store inputs
+                                #:key
+                                (mode (build-mode normal))
+                                (substitutable-info
+                                 (substitution-oracle
+                                  store
+                                  (map derivation-input-derivation
+                                       inputs)
+                                  #:mode mode)))
+  "Given INPUTS, a list of derivation-inputs, return two values: the list of
+derivation to build, and the list of substitutable items that, together,
+allows INPUTS to be realized.
 
-  (define input-built?
-    (compose (cut any built? <>) derivation-input-output-paths))
+SUBSTITUTABLE-INFO must be a one-argument procedure similar to that returned
+by 'substitution-oracle'."
+  (define (built? item)
+    (valid-path? store item))
 
-  (define input-substitutable?
-    ;; Return true if and only if all of SUB-DRVS are subsitutable.  If at
-    ;; least one is missing, then everything must be rebuilt.
-    (compose (cut every substitutable-info <>) derivation-input-output-paths))
-
-  (define (derivation-built? drv* sub-drvs)
+  (define (input-built? input)
     ;; In 'check' mode, assume that DRV is not built.
     (and (not (and (eqv? mode (build-mode check))
-                   (eq? drv* drv)))
-         (every built? (derivation-output-paths drv* sub-drvs))))
+                   (member input inputs)))
+         (every built? (derivation-input-output-paths input))))
 
-  (define (derivation-substitutable-info drv sub-drvs)
-    (and (substitutable-derivation? drv)
-         (let ((info (filter-map substitutable-info
-                                 (derivation-output-paths drv sub-drvs))))
-           (and (= (length info) (length sub-drvs))
+  (define (input-substitutable-info input)
+    (and (substitutable-derivation? (derivation-input-derivation input))
+         (let* ((items (derivation-input-output-paths input))
+                (info  (filter-map substitutable-info items)))
+           (and (= (length info) (length items))
                 info))))
 
-  (let loop ((drv        drv)
-             (sub-drvs   outputs)
-             (build      '())                     ;list of <derivation-input>
-             (substitute '()))                    ;list of <substitutable>
-    (cond ((derivation-built? drv sub-drvs)
-           (values build substitute))
-          ((derivation-substitutable-info drv sub-drvs)
-           =>
-           (lambda (substitutables)
-             (values build
-                     (append substitutables substitute))))
-          (else
-           (let ((build  (if (substitutable-derivation? drv)
-                             build
-                             (cons (make-derivation-input
-                                    (derivation-file-name drv) sub-drvs)
-                                   build)))
-                 (inputs (remove (lambda (i)
-                                   (or (member i build) ; XXX: quadratic
-                                       (input-built? i)
-                                       (input-substitutable? i)))
-                                 (derivation-inputs drv))))
-             (fold2 loop
-                    (append inputs build)
-                    (append (append-map (lambda (input)
-                                          (if (and (not (input-built? input))
-                                                   (input-substitutable? input))
-                                              (map substitutable-info
-                                                   (derivation-input-output-paths
-                                                    input))
-                                              '()))
-                                        (derivation-inputs drv))
-                            substitute)
-                    (map (lambda (i)
-                           (read-derivation-from-file
-                            (derivation-input-path i)))
-                         inputs)
-                    (map derivation-input-sub-derivations inputs)))))))
+  (let loop ((inputs     inputs)                  ;list of <derivation-input>
+             (build      '())                     ;list of <derivation>
+             (substitute '())                     ;list of <substitutable>
+             (visited    (set)))                  ;set of <derivation-input>
+    (match inputs
+      (()
+       (values build substitute))
+      ((input rest ...)
+       (cond ((set-contains? visited input)
+              (loop rest build substitute visited))
+             ((input-built? input)
+              (loop rest build substitute
+                    (set-insert input visited)))
+             ((input-substitutable-info input)
+              =>
+              (lambda (substitutables)
+                (loop rest build
+                      (append substitutables substitute)
+                      (set-insert input visited))))
+             (else
+              (let ((deps (derivation-inputs
+                           (derivation-input-derivation input))))
+                (loop (append deps rest)
+                      (cons (derivation-input-derivation input) build)
+                      substitute
+                      (set-insert input visited)))))))))
+
+(define-deprecated (derivation-prerequisites-to-build store drv #:rest rest)
+  derivation-build-plan
+  (let-values (((build download)
+                (apply derivation-build-plan store
+                       (list (derivation-input drv)) rest)))
+    (values (map derivation-input build) download)))
 
 (define (read-derivation drv-port)
   "Read the derivation from DRV-PORT and return the corresponding <derivation>
diff --git a/tests/derivations.scm b/tests/derivations.scm
index 93f4cdd8ee..35fb20bab0 100644
--- a/tests/derivations.scm
+++ b/tests/derivations.scm
@@ -809,13 +809,13 @@
              (equal? (pk 'x content) (pk 'y (call-with-input-file out get-string-all)))
              )))))
 
-(test-assert "build-expression->derivation and derivation-prerequisites-to-build"
+(test-assert "build-expression->derivation and derivation-build-plan"
   (let ((drv (build-expression->derivation %store "fail" #f)))
     ;; The only direct dependency is (%guile-for-build) and it's already
     ;; built.
-    (null? (derivation-prerequisites-to-build %store drv))))
+    (null? (derivation-build-plan %store (derivation-inputs drv)))))
 
-(test-assert "derivation-prerequisites-to-build when outputs already present"
+(test-assert "derivation-build-plan when outputs already present"
   (let* ((builder    `(begin ,(random-text) (mkdir %output) #t))
          (input-drv  (build-expression->derivation %store "input" builder))
          (input-path (derivation->output-path input-drv))
@@ -828,9 +828,12 @@
               (valid-path? %store output))
       (error "things already built" input-drv))
 
-    (and (equal? (map derivation-input-path
-                      (derivation-prerequisites-to-build %store drv))
-                 (list (derivation-file-name input-drv)))
+    (and (lset= equal?
+                (map derivation-file-name
+                     (derivation-build-plan %store
+                                            (list (derivation-input drv))))
+                (list (derivation-file-name input-drv)
+                      (derivation-file-name drv)))
 
          ;; Build DRV and delete its input.
          (build-derivations %store (list drv))
@@ -839,9 +842,10 @@
 
          ;; Now INPUT-PATH is missing, yet it shouldn't be listed as a
          ;; prerequisite to build because DRV itself is already built.
-         (null? (derivation-prerequisites-to-build %store drv)))))
+         (null? (derivation-build-plan %store
+                                       (list (derivation-input drv)))))))
 
-(test-assert "derivation-prerequisites-to-build and substitutes"
+(test-assert "derivation-build-plan and substitutes"
   (let* ((store  (open-connection))
          (drv    (build-expression->derivation store "prereq-subst"
                                                (random 1000)))
@@ -853,17 +857,19 @@
 
     (with-derivation-narinfo drv
       (let-values (((build download)
-                    (derivation-prerequisites-to-build store drv))
+                    (derivation-build-plan store
+                                           (list (derivation-input drv))))
                    ((build* download*)
-                    (derivation-prerequisites-to-build store drv
-                                                       #:substitutable-info
-                                                       (const #f))))
+                    (derivation-build-plan store
+                                           (list (derivation-input drv))
+                                           #:substitutable-info
+                                           (const #f))))
         (and (null? build)
              (equal? (map substitutable-path download) (list output))
              (null? download*)
-             (null? build*))))))
+             (equal? (list drv) build*))))))
 
-(test-assert "derivation-prerequisites-to-build and substitutes, non-substitutable build"
+(test-assert "derivation-build-plan and substitutes, non-substitutable build"
   (let* ((store  (open-connection))
          (drv    (build-expression->derivation store "prereq-no-subst"
                                                (random 1000)
@@ -876,16 +882,16 @@
 
     (with-derivation-narinfo drv
       (let-values (((build download)
-                    (derivation-prerequisites-to-build store drv)))
+                    (derivation-build-plan store
+                                           (list (derivation-input drv)))))
         ;; Despite being available as a substitute, DRV will be built locally
         ;; due to #:substitutable? #f.
         (and (null? download)
              (match build
-               (((? derivation-input? input))
-                (string=? (derivation-input-path input)
-                          (derivation-file-name drv)))))))))
+               (((= derivation-file-name build))
+                (string=? build (derivation-file-name drv)))))))))
 
-(test-assert "derivation-prerequisites-to-build and substitutes, local build"
+(test-assert "derivation-build-plan and substitutes, local build"
   (with-store store
     (let* ((drv    (build-expression->derivation store "prereq-subst-local"
                                                  (random 1000)
@@ -898,7 +904,8 @@
 
       (with-derivation-narinfo drv
         (let-values (((build download)
-                      (derivation-prerequisites-to-build store drv)))
+                      (derivation-build-plan store
+                                             (list (derivation-input drv)))))
           ;; #:local-build? is *not* synonymous with #:substitutable?, so we
           ;; must be able to substitute DRV's output.
           ;; See <http://bugs.gnu.org/18747>.
@@ -907,7 +914,7 @@
                  (((= substitutable-path item))
                   (string=? item (derivation->output-path drv))))))))))
 
-(test-assert "derivation-prerequisites-to-build in 'check' mode"
+(test-assert "derivation-build-plan in 'check' mode"
   (with-store store
     (let* ((dep (build-expression->derivation store "dep"
                                               `(begin ,(random-text)
@@ -919,13 +926,13 @@
       (delete-paths store (list (derivation->output-path dep)))
 
       ;; In 'check' mode, DEP must be rebuilt.
-      (and (null? (derivation-prerequisites-to-build store drv))
-           (match (derivation-prerequisites-to-build store drv
-                                                     #:mode (build-mode
-                                                             check))
-             ((input)
-              (string=? (derivation-input-path input)
-                        (derivation-file-name dep))))))))
+      (and (null? (derivation-build-plan store
+                                         (list (derivation-input drv))))
+           (lset= equal?
+                  (derivation-build-plan store
+                                         (list (derivation-input drv))
+                                         #:mode (build-mode check))
+                  (list drv dep))))))
 
 (test-assert "substitution-oracle and #:substitute? #f"
   (with-store store
-- 
2.22.0

^ permalink raw reply related	[flat|nested] 12+ messages in thread

* [bug#36351] [PATCH 03/10] ui: 'show-what-to-build' uses 'derivation-build-plan'.
  2019-06-24 12:22 ` [bug#36351] [PATCH 01/10] derivations: Add 'derivation-input' Ludovic Courtès
  2019-06-24 12:22   ` [bug#36351] [PATCH 02/10] derivations: Rewrite and replace 'derivations-prerequisites-to-build' Ludovic Courtès
@ 2019-06-24 12:22   ` Ludovic Courtès
  2019-06-24 12:22   ` [bug#36351] [PATCH 04/10] graph: Use 'derivation-input-derivation' Ludovic Courtès
                     ` (6 subsequent siblings)
  8 siblings, 0 replies; 12+ messages in thread
From: Ludovic Courtès @ 2019-06-24 12:22 UTC (permalink / raw)
  To: 36351

* guix/ui.scm (show-what-to-build)[build-or-substitutable?]: Remove.
Use 'derivation-build-plan' instead of
'derivation-prerequisites-to-build', passing it all of DRV at once, and
remove 'fold2' shenanigans and postprocessing of BUILD.
---
 guix/ui.scm | 32 +++++++-------------------------
 1 file changed, 7 insertions(+), 25 deletions(-)

diff --git a/guix/ui.scm b/guix/ui.scm
index 0b4fe144b6..3c67fbaa24 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -41,7 +41,6 @@
   #:use-module (guix packages)
   #:use-module (guix profiles)
   #:use-module (guix derivations)
-  #:use-module (guix combinators)
   #:use-module (guix build-system)
   #:use-module (guix serialization)
   #:use-module ((guix licenses) #:select (license? license-name))
@@ -820,29 +819,12 @@ report what is prerequisites are available for download."
         (substitution-oracle store drv #:mode mode)
         (const #f)))
 
-  (define (built-or-substitutable? drv)
-    (or (null? (derivation-outputs drv))
-        (let ((out (derivation->output-path drv))) ;XXX: assume "out" exists
-          (or (valid-path? store out)
-              (substitutable-info out)))))
-
   (let*-values (((build download)
-                 (fold2 (lambda (drv build download)
-                          (let-values (((b d)
-                                        (derivation-prerequisites-to-build
-                                         store drv
-                                         #:mode mode
-                                         #:substitutable-info
-                                         substitutable-info)))
-                            (values (append b build)
-                                    (append d download))))
-                        '() '()
-                        drv))
-                ((build)                          ; add the DRV themselves
-                 (delete-duplicates
-                  (append (map derivation-file-name
-                               (remove built-or-substitutable? drv))
-                          (map derivation-input-path build))))
+                 (derivation-build-plan store
+                                        (map derivation-input drv)
+                                        #:mode mode
+                                        #:substitutable-info
+                                        substitutable-info))
                 ((download)                   ; add the references of DOWNLOAD
                  (if use-substitutes?
                      (delete-duplicates
@@ -856,8 +838,8 @@ report what is prerequisites are available for download."
                                            download))))
                      download))
                 ((graft hook build)
-                 (match (fold (lambda (file acc)
-                                (let ((drv (read-derivation-from-file file)))
+                 (match (fold (lambda (drv acc)
+                                (let ((file (derivation-file-name drv)))
                                   (match acc
                                     ((#:graft graft #:hook hook #:build build)
                                      (cond
-- 
2.22.0

^ permalink raw reply related	[flat|nested] 12+ messages in thread

* [bug#36351] [PATCH 04/10] graph: Use 'derivation-input-derivation'.
  2019-06-24 12:22 ` [bug#36351] [PATCH 01/10] derivations: Add 'derivation-input' Ludovic Courtès
  2019-06-24 12:22   ` [bug#36351] [PATCH 02/10] derivations: Rewrite and replace 'derivations-prerequisites-to-build' Ludovic Courtès
  2019-06-24 12:22   ` [bug#36351] [PATCH 03/10] ui: 'show-what-to-build' uses 'derivation-build-plan' Ludovic Courtès
@ 2019-06-24 12:22   ` Ludovic Courtès
  2019-06-24 12:22   ` [bug#36351] [PATCH 05/10] derivations: <derivation-input> now aggregates a <derivation> Ludovic Courtès
                     ` (5 subsequent siblings)
  8 siblings, 0 replies; 12+ messages in thread
From: Ludovic Courtès @ 2019-06-24 12:22 UTC (permalink / raw)
  To: 36351

* guix/scripts/graph.scm (derivation-dependencies): Use
'derivation-input-derivation'.
---
 guix/scripts/graph.scm | 3 +--
 1 file changed, 1 insertion(+), 2 deletions(-)

diff --git a/guix/scripts/graph.scm b/guix/scripts/graph.scm
index 8fe81ad64b..2e14857f1e 100644
--- a/guix/scripts/graph.scm
+++ b/guix/scripts/graph.scm
@@ -254,8 +254,7 @@ GNU-BUILD-SYSTEM have zero dependencies."
   "Return the <derivation> objects and store items corresponding to the
 dependencies of OBJ, a <derivation> or store item."
   (if (derivation? obj)
-      (append (map (compose read-derivation-from-file derivation-input-path)
-                   (derivation-inputs obj))
+      (append (map derivation-input-derivation (derivation-inputs obj))
               (derivation-sources obj))
       '()))
 
-- 
2.22.0

^ permalink raw reply related	[flat|nested] 12+ messages in thread

* [bug#36351] [PATCH 05/10] derivations: <derivation-input> now aggregates a <derivation>.
  2019-06-24 12:22 ` [bug#36351] [PATCH 01/10] derivations: Add 'derivation-input' Ludovic Courtès
                     ` (2 preceding siblings ...)
  2019-06-24 12:22   ` [bug#36351] [PATCH 04/10] graph: Use 'derivation-input-derivation' Ludovic Courtès
@ 2019-06-24 12:22   ` Ludovic Courtès
  2019-06-24 12:22   ` [bug#36351] [PATCH 06/10] derivations: 'derivation' preserves pointer equality Ludovic Courtès
                     ` (4 subsequent siblings)
  8 siblings, 0 replies; 12+ messages in thread
From: Ludovic Courtès @ 2019-06-24 12:22 UTC (permalink / raw)
  To: 36351

Consequently, the whole graph of <derivation> object is readily
available without having to go through 'read-derivation-from-file',
which could have cache misses if the requested <derivation> object had
been GC'd in the meantime.  This is an important property for the
performance of things like 'derivation-build-plan' that traverse the
derivation graph.

* guix/derivations.scm (<derivation-input>): Replace 'path' field by
'derivation'.
(derivation-input-path): Adjust accordingly.
(derivation-input-key): New procedure.
(derivation-input-output-paths): Adjust accordingly.
(coalesce-duplicate-inputs): Likewise.
(derivation-prerequisites): Use 'derivation-input-key' to compute keys
for INPUT-SET.
(derivation-build-plan): Likewise.
(read-derivation): Add optional 'read-derivation-from-file' parameter.
[make-input-drvs]: Call it.
(write-derivation)[write-input]: Adjust to new <derivation-input>.
(derivation/masked-inputs): Likewise, and remove redundant
'coalesce-duplicate-inputs' call.
(derivation)[input->derivation-input]: Change to consider only the
derivation case.  Update call to 'make-derivation-input'.
[input->source]: New procedure.
Separate sources from inputs.
(map-derivation): Adjust to new <derivation-input>.
* tests/derivations.scm ("parse & export"): Pass a second argument to
'read-derivation'.
("build-expression->derivation and derivation-prerequisites")
("derivation-prerequisites and valid-derivation-input?"): Adjust to new
<derivation-input>.
---
 guix/derivations.scm  | 156 ++++++++++++++++++++++++------------------
 tests/derivations.scm |  10 +--
 2 files changed, 95 insertions(+), 71 deletions(-)

diff --git a/guix/derivations.scm b/guix/derivations.scm
index f6e94694fd..5c568f223b 100644
--- a/guix/derivations.scm
+++ b/guix/derivations.scm
@@ -152,22 +152,28 @@
   (recursive? derivation-output-recursive?))      ; Boolean
 
 (define-immutable-record-type <derivation-input>
-  (make-derivation-input path sub-derivations)
+  (make-derivation-input drv sub-derivations)
   derivation-input?
-  (path            derivation-input-path)             ; store path
+  (drv             derivation-input-derivation)       ; <derivation>
   (sub-derivations derivation-input-sub-derivations)) ; list of strings
 
-(define (derivation-input-derivation input)
-  "Return the <derivation> object INPUT refers to."
-  (read-derivation-from-file (derivation-input-path input)))
+
+(define (derivation-input-path input)
+  "Return the file name of the derivation INPUT refers to."
+  (derivation-file-name (derivation-input-derivation input)))
 
 (define* (derivation-input drv #:optional
                            (outputs (derivation-output-names drv)))
   "Return a <derivation-input> for the OUTPUTS of DRV."
   ;; This is a public interface meant to be more convenient than
   ;; 'make-derivation-input' and giving us more control.
-  (make-derivation-input (derivation-file-name drv)
-                         outputs))
+  (make-derivation-input drv outputs))
+
+(define (derivation-input-key input)
+  "Return an object for which 'equal?' and 'hash' are constant-time, and which
+can thus be used as a key for INPUT in lookup tables."
+  (cons (derivation-input-path input)
+        (derivation-input-sub-derivations input)))
 
 (set-record-type-printer! <derivation>
                           (lambda (drv port)
@@ -209,8 +215,8 @@ download with a fixed hash (aka. `fetchurl')."
   "Return the list of output paths corresponding to INPUT, a
 <derivation-input>."
   (match input
-    (($ <derivation-input> path sub-drvs)
-     (map (cut derivation-path->output-path path <>)
+    (($ <derivation-input> drv sub-drvs)
+     (map (cut derivation->output-path drv <>)
           sub-drvs))))
 
 (define (valid-derivation-input? store input)
@@ -225,20 +231,20 @@ they are coalesced, with their sub-derivations merged.  This is needed because
 Nix itself keeps only one of them."
   (fold (lambda (input result)
           (match input
-            (($ <derivation-input> path sub-drvs)
+            (($ <derivation-input> (= derivation-file-name path) sub-drvs)
              ;; XXX: quadratic
              (match (find (match-lambda
-                            (($ <derivation-input> p s)
+                            (($ <derivation-input> (= derivation-file-name p)
+                                                   s)
                              (string=? p path)))
                           result)
                (#f
                 (cons input result))
-               ((and dup ($ <derivation-input> _ sub-drvs2))
+               ((and dup ($ <derivation-input> drv sub-drvs2))
                 ;; Merge DUP with INPUT.
                 (let ((sub-drvs (delete-duplicates
                                  (append sub-drvs sub-drvs2))))
-                  (cons (make-derivation-input path
-                                               (sort sub-drvs string<?))
+                  (cons (make-derivation-input drv (sort sub-drvs string<?))
                         (delq dup result))))))))
         '()
         inputs))
@@ -254,12 +260,14 @@ result is the set of prerequisites of DRV not already in valid."
              (result    '())
              (input-set (set)))
     (let ((inputs (remove (lambda (input)
-                            (or (set-contains? input-set input)
+                            (or (set-contains? input-set
+                                               (derivation-input-key input))
                                 (cut? input)))
                           (derivation-inputs drv))))
       (fold2 loop
              (append inputs result)
-             (fold set-insert input-set inputs)
+             (fold set-insert input-set
+                   (map derivation-input-key inputs))
              (map derivation-input-derivation inputs)))))
 
 (define (offloadable-derivation? drv)
@@ -384,24 +392,25 @@ by 'substitution-oracle'."
       (()
        (values build substitute))
       ((input rest ...)
-       (cond ((set-contains? visited input)
-              (loop rest build substitute visited))
-             ((input-built? input)
-              (loop rest build substitute
-                    (set-insert input visited)))
-             ((input-substitutable-info input)
-              =>
-              (lambda (substitutables)
-                (loop rest build
-                      (append substitutables substitute)
-                      (set-insert input visited))))
-             (else
-              (let ((deps (derivation-inputs
-                           (derivation-input-derivation input))))
-                (loop (append deps rest)
-                      (cons (derivation-input-derivation input) build)
-                      substitute
-                      (set-insert input visited)))))))))
+       (let ((key (derivation-input-key input)))
+         (cond ((set-contains? visited key)
+                (loop rest build substitute visited))
+               ((input-built? input)
+                (loop rest build substitute
+                      (set-insert key visited)))
+               ((input-substitutable-info input)
+                =>
+                (lambda (substitutables)
+                  (loop rest build
+                        (append substitutables substitute)
+                        (set-insert key visited))))
+               (else
+                (let ((deps (derivation-inputs
+                             (derivation-input-derivation input))))
+                  (loop (append deps rest)
+                        (cons (derivation-input-derivation input) build)
+                        substitute
+                        (set-insert key visited))))))))))
 
 (define-deprecated (derivation-prerequisites-to-build store drv #:rest rest)
   derivation-build-plan
@@ -410,10 +419,15 @@ by 'substitution-oracle'."
                        (list (derivation-input drv)) rest)))
     (values (map derivation-input build) download)))
 
-(define (read-derivation drv-port)
+(define* (read-derivation drv-port
+                          #:optional (read-derivation-from-file
+                                      read-derivation-from-file))
   "Read the derivation from DRV-PORT and return the corresponding <derivation>
-object.  Most of the time you'll want to use 'read-derivation-from-file',
-which caches things as appropriate and is thus more efficient."
+object.  Call READ-DERIVATION-FROM-FILE to read derivations declared as inputs
+of the derivation being parsed.
+
+Most of the time you'll want to use 'read-derivation-from-file', which caches
+things as appropriate and is thus more efficient."
 
   (define comma (string->symbol ","))
 
@@ -449,8 +463,9 @@ which caches things as appropriate and is thus more efficient."
     (fold-right (lambda (input result)
                   (match input
                     ((path (sub-drvs ...))
-                     (cons (make-derivation-input path sub-drvs)
-                           result))))
+                     (let ((drv (read-derivation-from-file path)))
+                       (cons (make-derivation-input drv sub-drvs)
+                             result)))))
                 '()
                 x))
 
@@ -552,9 +567,15 @@ that form."
 
   (define (write-input input port)
     (match input
-      (($ <derivation-input> path sub-drvs)
+      (($ <derivation-input> obj sub-drvs)
        (display "(\"" port)
-       (display path port)
+
+       ;; 'derivation/masked-inputs' produces objects that contain a string
+       ;; instead of a <derivation>, so we need to account for that.
+       (display (if (derivation? obj)
+                    (derivation-file-name obj)
+                    obj)
+                port)
        (display "\"," port)
        (write-string-list sub-drvs)
        (display ")" port))))
@@ -645,13 +666,16 @@ name of each input with that input's hash."
     (($ <derivation> outputs inputs sources
                      system builder args env-vars)
      (let ((inputs (map (match-lambda
-                          (($ <derivation-input> path sub-drvs)
+                          (($ <derivation-input> (= derivation-file-name path)
+                                                 sub-drvs)
                            (let ((hash (derivation-path->base16-hash path)))
                              (make-derivation-input hash sub-drvs))))
                         inputs)))
        (make-derivation outputs
-                        (sort (coalesce-duplicate-inputs inputs)
-                              derivation-input<?)
+                        (sort inputs
+                              (lambda (drv1 drv2)
+                                (string<? (derivation-input-derivation drv1)
+                                          (derivation-input-derivation drv2))))
                         sources
                         system builder args env-vars
                         #f)))))
@@ -807,17 +831,19 @@ derivation.  It is kept as-is, uninterpreted, in the derivation."
   (define input->derivation-input
     (match-lambda
       (((? derivation? drv))
-       (make-derivation-input (derivation-file-name drv) '("out")))
+       (make-derivation-input 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 ...)
-       (make-derivation-input input sub-drvs))
-      ((input . _)
-       (let ((path (add-to-store store (basename input)
-                                 #t "sha256" input)))
-         (make-derivation-input path '())))))
+       (make-derivation-input drv sub-drvs))
+      (_ #f)))
+
+  (define input->source
+    (match-lambda
+      (((? string? input) . _)
+       (if (direct-store-path? input)
+           input
+           (add-to-store store (basename input)
+                         #t "sha256" input)))
+      (_ #f)))
 
   ;; Note: lists are sorted alphabetically, to conform with the behavior of
   ;; C++ `std::map' in Nix itself.
@@ -828,29 +854,24 @@ derivation.  It is kept as-is, uninterpreted, in the derivation."
                                   (make-derivation-output "" hash-algo
                                                           hash recursive?)))
                           (sort outputs string<?)))
+         (sources    (sort (delete-duplicates
+                            (filter-map input->source inputs))
+                           string<?))
          (inputs     (sort (coalesce-duplicate-inputs
-                            (map input->derivation-input
-                                 (delete-duplicates inputs)))
+                            (filter-map input->derivation-input inputs))
                            derivation-input<?))
          (env-vars   (sort (env-vars-with-empty-outputs
                             (user+system-env-vars))
                            (lambda (e1 e2)
                              (string<? (car e1) (car e2)))))
-         (drv-masked (make-derivation outputs
-                                      (filter (compose derivation-path?
-                                                       derivation-input-path)
-                                              inputs)
-                                      (filter-map (lambda (i)
-                                                    (let ((p (derivation-input-path i)))
-                                                      (and (not (derivation-path? p))
-                                                           p)))
-                                                  inputs)
+         (drv-masked (make-derivation outputs inputs sources
                                       system builder args env-vars #f))
          (drv        (add-output-paths drv-masked)))
 
     (let* ((file (add-data-to-store store (string-append name ".drv")
                                     (derivation->bytevector drv)
-                                    (map derivation-input-path inputs)))
+                                    (append (map derivation-input-path inputs)
+                                            sources)))
            (drv* (set-field drv (derivation-file-name) file)))
       (hash-set! %derivation-cache file drv*)
       drv*)))
@@ -920,7 +941,8 @@ recursively."
       ;; in the format used in 'derivation' calls.
       (mlambda (input loop)
         (match input
-          (($ <derivation-input> path (sub-drvs ...))
+          (($ <derivation-input> (= derivation-file-name path)
+                                 (sub-drvs ...))
            (match (vhash-assoc path mapping)
              ((_ . (? derivation? replacement))
               (cons replacement sub-drvs))
diff --git a/tests/derivations.scm b/tests/derivations.scm
index 35fb20bab0..54fa588969 100644
--- a/tests/derivations.scm
+++ b/tests/derivations.scm
@@ -87,9 +87,11 @@
 (test-assert "parse & export"
   (let* ((f  (search-path %load-path "tests/test.drv"))
          (b1 (call-with-input-file f get-bytevector-all))
-         (d1 (read-derivation (open-bytevector-input-port b1)))
+         (d1 (read-derivation (open-bytevector-input-port b1)
+                              identity))
          (b2 (call-with-bytevector-output-port (cut write-derivation d1 <>)))
-         (d2 (read-derivation (open-bytevector-input-port b2))))
+         (d2 (read-derivation (open-bytevector-input-port b2)
+                              identity)))
     (and (equal? b1 b2)
          (equal? d1 d2))))
 
@@ -724,7 +726,7 @@
 (test-assert "build-expression->derivation and derivation-prerequisites"
   (let ((drv (build-expression->derivation %store "fail" #f)))
     (any (match-lambda
-          (($ <derivation-input> path)
+          (($ <derivation-input> (= derivation-file-name path))
            (string=? path (derivation-file-name (%guile-for-build)))))
          (derivation-prerequisites drv))))
 
@@ -741,7 +743,7 @@
     (match (derivation-prerequisites c
                                      (cut valid-derivation-input? %store
                                           <>))
-      ((($ <derivation-input> file ("out")))
+      ((($ <derivation-input> (= derivation-file-name file) ("out")))
        (string=? file (derivation-file-name b)))
       (x
        (pk 'fail x #f)))))
-- 
2.22.0

^ permalink raw reply related	[flat|nested] 12+ messages in thread

* [bug#36351] [PATCH 06/10] derivations: 'derivation' preserves pointer equality.
  2019-06-24 12:22 ` [bug#36351] [PATCH 01/10] derivations: Add 'derivation-input' Ludovic Courtès
                     ` (3 preceding siblings ...)
  2019-06-24 12:22   ` [bug#36351] [PATCH 05/10] derivations: <derivation-input> now aggregates a <derivation> Ludovic Courtès
@ 2019-06-24 12:22   ` Ludovic Courtès
  2019-06-24 12:22   ` [bug#36351] [PATCH 07/10] derivations: 'build-derivations' can be passed derivation inputs Ludovic Courtès
                     ` (3 subsequent siblings)
  8 siblings, 0 replies; 12+ messages in thread
From: Ludovic Courtès @ 2019-06-24 12:22 UTC (permalink / raw)
  To: 36351

* guix/derivations.scm (derivation): Check if FILE is already in
%DERIVATION-CACHE and return it if it is.
---
 guix/derivations.scm | 8 ++++++--
 1 file changed, 6 insertions(+), 2 deletions(-)

diff --git a/guix/derivations.scm b/guix/derivations.scm
index 5c568f223b..403e86749b 100644
--- a/guix/derivations.scm
+++ b/guix/derivations.scm
@@ -873,8 +873,12 @@ derivation.  It is kept as-is, uninterpreted, in the derivation."
                                     (append (map derivation-input-path inputs)
                                             sources)))
            (drv* (set-field drv (derivation-file-name) file)))
-      (hash-set! %derivation-cache file drv*)
-      drv*)))
+      ;; Preserve pointer equality.  This improves the performance of
+      ;; 'eq?'-memoization on derivations.
+      (or (hash-ref %derivation-cache file)
+          (begin
+            (hash-set! %derivation-cache file drv*)
+            drv*)))))
 
 (define (invalidate-derivation-caches!)
   "Invalidate internal derivation caches.  This is mostly useful for
-- 
2.22.0

^ permalink raw reply related	[flat|nested] 12+ messages in thread

* [bug#36351] [PATCH 07/10] derivations: 'build-derivations' can be passed derivation inputs.
  2019-06-24 12:22 ` [bug#36351] [PATCH 01/10] derivations: Add 'derivation-input' Ludovic Courtès
                     ` (4 preceding siblings ...)
  2019-06-24 12:22   ` [bug#36351] [PATCH 06/10] derivations: 'derivation' preserves pointer equality Ludovic Courtès
@ 2019-06-24 12:22   ` Ludovic Courtès
  2019-06-24 12:22   ` [bug#36351] [PATCH 08/10] packages: 'specification->package+output' distinguishes "no output specified" Ludovic Courtès
                     ` (2 subsequent siblings)
  8 siblings, 0 replies; 12+ messages in thread
From: Ludovic Courtès @ 2019-06-24 12:22 UTC (permalink / raw)
  To: 36351

* guix/derivations.scm (build-derivations): Accept <derivation-input>
records among DERIVATIONS.
* tests/derivations.scm ("build-derivations with specific output"): Test
it.
---
 guix/derivations.scm  | 5 +++++
 tests/derivations.scm | 7 +++++--
 2 files changed, 10 insertions(+), 2 deletions(-)

diff --git a/guix/derivations.scm b/guix/derivations.scm
index 403e86749b..433b4551a5 100644
--- a/guix/derivations.scm
+++ b/guix/derivations.scm
@@ -1016,6 +1016,11 @@ derivation/output pairs, using the specified MODE."
   (build-things store (map (match-lambda
                             ((? derivation? drv)
                              (derivation-file-name drv))
+                            ((? derivation-input? input)
+                             (cons (derivation-input-path input)
+                                   (string-join
+                                    (derivation-input-sub-derivations input)
+                                    ",")))
                             ((? string? file) file)
                             (((? derivation? drv) . output)
                              (cons (derivation-file-name drv)
diff --git a/tests/derivations.scm b/tests/derivations.scm
index 54fa588969..d173a78906 100644
--- a/tests/derivations.scm
+++ b/tests/derivations.scm
@@ -807,9 +807,12 @@
              ;; Ask for nothing but the "out" output of DRV.
              (build-derivations store `((,drv . "out")))
 
+             ;; Synonymous:
+             (build-derivations store (list (derivation-input drv '("out"))))
+
              (valid-path? store out)
-             (equal? (pk 'x content) (pk 'y (call-with-input-file out get-string-all)))
-             )))))
+             (equal? (pk 'x content)
+                     (pk 'y (call-with-input-file out get-string-all))))))))
 
 (test-assert "build-expression->derivation and derivation-build-plan"
   (let ((drv (build-expression->derivation %store "fail" #f)))
-- 
2.22.0

^ permalink raw reply related	[flat|nested] 12+ messages in thread

* [bug#36351] [PATCH 08/10] packages: 'specification->package+output' distinguishes "no output specified".
  2019-06-24 12:22 ` [bug#36351] [PATCH 01/10] derivations: Add 'derivation-input' Ludovic Courtès
                     ` (5 preceding siblings ...)
  2019-06-24 12:22   ` [bug#36351] [PATCH 07/10] derivations: 'build-derivations' can be passed derivation inputs Ludovic Courtès
@ 2019-06-24 12:22   ` Ludovic Courtès
  2019-06-24 12:22   ` [bug#36351] [PATCH 09/10] ui: 'show-what-to-build' accepts derivation inputs Ludovic Courtès
  2019-06-24 12:22   ` [bug#36351] [PATCH 10/10] ui: 'show-derivation-outputs' accepts <derivation-input> records Ludovic Courtès
  8 siblings, 0 replies; 12+ messages in thread
From: Ludovic Courtès @ 2019-06-24 12:22 UTC (permalink / raw)
  To: 36351

Until now the caller couldn't tell the different between a spec like
"foo:out" and one like "foo".  This change allows users to distinguish
between these two cases.

* gnu/packages.scm (specification->package+output): Disable output
membership test when OUTPUT = #f and SUB-DRV = #f.
* tests/packages.scm ("specification->package+output")
("specification->package+output invalid output")
("specification->package+output no default output")
("specification->package+output invalid output, no default"): New tests.
---
 gnu/packages.scm   |  8 ++++++--
 tests/packages.scm | 32 ++++++++++++++++++++++++++++++++
 2 files changed, 38 insertions(+), 2 deletions(-)

diff --git a/gnu/packages.scm b/gnu/packages.scm
index 48390575ba..acb247e114 100644
--- a/gnu/packages.scm
+++ b/gnu/packages.scm
@@ -534,14 +534,18 @@ optionally contain a version number and an output name, as in these examples:
   guile@2.0.9:debug
 
 If SPEC does not specify a version number, return the preferred newest
-version; if SPEC does not specify an output, return OUTPUT."
+version; if SPEC does not specify an output, return OUTPUT.
+
+When OUTPUT is false and SPEC does not specify any output, return #f as the
+output."
   (let-values (((name version sub-drv)
                 (package-specification->name+version+output spec output)))
     (match (%find-package spec name version)
       (#f
        (values #f #f))
       (package
-       (if (member sub-drv (package-outputs package))
+       (if (or (and (not output) (not sub-drv))
+               (member sub-drv (package-outputs package)))
            (values package sub-drv)
            (leave (G_ "package `~a' lacks output `~a'~%")
                   (package-full-name package)
diff --git a/tests/packages.scm b/tests/packages.scm
index 613b2f1221..836d446657 100644
--- a/tests/packages.scm
+++ b/tests/packages.scm
@@ -1227,6 +1227,38 @@
     (lambda (key . args)
       key)))
 
+(test-equal "specification->package+output"
+  `((,coreutils "out") (,coreutils "debug"))
+  (list (call-with-values (lambda ()
+                            (specification->package+output "coreutils"))
+          list)
+        (call-with-values (lambda ()
+                            (specification->package+output "coreutils:debug"))
+          list)))
+
+(test-equal "specification->package+output invalid output"
+  'error
+  (catch 'quit
+    (lambda ()
+      (specification->package+output "coreutils:does-not-exist"))
+    (lambda _
+      'error)))
+
+(test-equal "specification->package+output no default output"
+  `(,coreutils #f)
+  (call-with-values
+    (lambda ()
+      (specification->package+output "coreutils" #f))
+    list))
+
+(test-equal "specification->package+output invalid output, no default"
+  'error
+  (catch 'quit
+    (lambda ()
+      (specification->package+output "coreutils:does-not-exist" #f))
+    (lambda _
+      'error)))
+
 (test-equal "find-package-locations"
   (map (lambda (package)
          (cons (package-version package)
-- 
2.22.0

^ permalink raw reply related	[flat|nested] 12+ messages in thread

* [bug#36351] [PATCH 09/10] ui: 'show-what-to-build' accepts derivation inputs.
  2019-06-24 12:22 ` [bug#36351] [PATCH 01/10] derivations: Add 'derivation-input' Ludovic Courtès
                     ` (6 preceding siblings ...)
  2019-06-24 12:22   ` [bug#36351] [PATCH 08/10] packages: 'specification->package+output' distinguishes "no output specified" Ludovic Courtès
@ 2019-06-24 12:22   ` Ludovic Courtès
  2019-06-24 12:22   ` [bug#36351] [PATCH 10/10] ui: 'show-derivation-outputs' accepts <derivation-input> records Ludovic Courtès
  8 siblings, 0 replies; 12+ messages in thread
From: Ludovic Courtès @ 2019-06-24 12:22 UTC (permalink / raw)
  To: 36351

This is a followup to f8a9f99cd602ce1dc5307cb0c21ae718ad8796bb.

* guix/ui.scm (show-what-to-build)[inputs]: New variables.
[substitutable-info]: Build the derivation list from INPUTS.
Pass INPUTS to 'derivation-build-plan'.
---
 guix/ui.scm | 20 ++++++++++++++------
 1 file changed, 14 insertions(+), 6 deletions(-)

diff --git a/guix/ui.scm b/guix/ui.scm
index 3c67fbaa24..bdcae34ee2 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -808,20 +808,28 @@ warning."
                              #:key dry-run? (use-substitutes? #t)
                              (mode (build-mode normal)))
   "Show what will or would (depending on DRY-RUN?) be built in realizing the
-derivations listed in DRV using MODE, a 'build-mode' value.  Return #t if
-there's something to build, #f otherwise.  When USE-SUBSTITUTES?, check and
-report what is prerequisites are available for download."
+derivations listed in DRV using MODE, a 'build-mode' value.  The elements of
+DRV can be either derivations or derivation inputs.
+
+Return #t if there's something to build, #f otherwise.  When USE-SUBSTITUTES?,
+check and report what is prerequisites are available for download."
+  (define inputs
+    (map (match-lambda
+           ((? derivation? drv) (derivation-input drv))
+           ((? derivation-input? input) input))
+         drv))
+
   (define substitutable-info
     ;; Call 'substitutation-oracle' upfront so we don't end up launching the
     ;; substituter many times.  This makes a big difference, especially when
     ;; DRV is a long list as is the case with 'guix environment'.
     (if use-substitutes?
-        (substitution-oracle store drv #:mode mode)
+        (substitution-oracle store (map derivation-input-derivation inputs)
+                             #:mode mode)
         (const #f)))
 
   (let*-values (((build download)
-                 (derivation-build-plan store
-                                        (map derivation-input drv)
+                 (derivation-build-plan store inputs
                                         #:mode mode
                                         #:substitutable-info
                                         substitutable-info))
-- 
2.22.0

^ permalink raw reply related	[flat|nested] 12+ messages in thread

* [bug#36351] [PATCH 10/10] ui: 'show-derivation-outputs' accepts <derivation-input> records.
  2019-06-24 12:22 ` [bug#36351] [PATCH 01/10] derivations: Add 'derivation-input' Ludovic Courtès
                     ` (7 preceding siblings ...)
  2019-06-24 12:22   ` [bug#36351] [PATCH 09/10] ui: 'show-what-to-build' accepts derivation inputs Ludovic Courtès
@ 2019-06-24 12:22   ` Ludovic Courtès
  8 siblings, 0 replies; 12+ messages in thread
From: Ludovic Courtès @ 2019-06-24 12:22 UTC (permalink / raw)
  To: 36351

* guix/ui.scm (show-derivation-outputs): Handle <derivation-input>
records.
---
 guix/ui.scm | 19 +++++++++++++------
 1 file changed, 13 insertions(+), 6 deletions(-)

diff --git a/guix/ui.scm b/guix/ui.scm
index bdcae34ee2..b6985adf23 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -773,12 +773,19 @@ error."
             str))))
 
 (define (show-derivation-outputs derivation)
-  "Show the output file names of DERIVATION."
-  (format #t "~{~a~%~}"
-          (map (match-lambda
-                 ((out-name . out)
-                  (derivation->output-path derivation out-name)))
-               (derivation-outputs derivation))))
+  "Show the output file names of DERIVATION, which can be a derivation or a
+derivation input."
+  (define (show-outputs derivation outputs)
+    (format #t "~{~a~%~}"
+            (map (cut derivation->output-path derivation <>)
+                 outputs)))
+
+  (match derivation
+    ((? derivation?)
+     (show-outputs derivation (derivation-output-names derivation)))
+    ((? derivation-input? input)
+     (show-outputs (derivation-input-derivation input)
+                   (derivation-input-sub-derivations input)))))
 
 (define* (check-available-space need
                                 #:optional (directory (%store-prefix)))
-- 
2.22.0

^ permalink raw reply related	[flat|nested] 12+ messages in thread

* bug#36351: [PATCH 00/10] Add 'derivation-build-plan', improve (guix derivations)
  2019-06-24 12:18 [bug#36351] [PATCH 00/10] Add 'derivation-build-plan', improve (guix derivations) Ludovic Courtès
  2019-06-24 12:22 ` [bug#36351] [PATCH 01/10] derivations: Add 'derivation-input' Ludovic Courtès
@ 2019-06-27  9:17 ` Ludovic Courtès
  1 sibling, 0 replies; 12+ messages in thread
From: Ludovic Courtès @ 2019-06-27  9:17 UTC (permalink / raw)
  To: 36351-done

Hello,

Ludovic Courtès <ludo@gnu.org> skribis:

> This is the season cleanup of (guix derivations)!

I went ahead and pushed the whole shebang:

08c95ba28d ui: 'show-derivation-outputs' accepts <derivation-input> records.
d38d4ffa10 ui: 'show-what-to-build' accepts derivation inputs.
066eeae1a1 packages: 'specification->package+output' distinguishes "no output specified".
7c690a4738 derivations: 'build-derivations' can be passed derivation inputs.
fd951cd543 derivations: 'derivation' preserves pointer equality.
5cf4b26d52 derivations: <derivation-input> now aggregates a <derivation>.
a250061986 graph: Use 'derivation-input-derivation'.
9844d0091e ui: 'show-what-to-build' uses 'derivation-build-plan'.
ba04f80e2e derivations: Rewrite and replace 'derivations-prerequisites-to-build'.
c89985d91d derivations: Add 'derivation-input'.

Ludo’.

^ permalink raw reply	[flat|nested] 12+ messages in thread

end of thread, other threads:[~2019-06-27  9:18 UTC | newest]

Thread overview: 12+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2019-06-24 12:18 [bug#36351] [PATCH 00/10] Add 'derivation-build-plan', improve (guix derivations) Ludovic Courtès
2019-06-24 12:22 ` [bug#36351] [PATCH 01/10] derivations: Add 'derivation-input' Ludovic Courtès
2019-06-24 12:22   ` [bug#36351] [PATCH 02/10] derivations: Rewrite and replace 'derivations-prerequisites-to-build' Ludovic Courtès
2019-06-24 12:22   ` [bug#36351] [PATCH 03/10] ui: 'show-what-to-build' uses 'derivation-build-plan' Ludovic Courtès
2019-06-24 12:22   ` [bug#36351] [PATCH 04/10] graph: Use 'derivation-input-derivation' Ludovic Courtès
2019-06-24 12:22   ` [bug#36351] [PATCH 05/10] derivations: <derivation-input> now aggregates a <derivation> Ludovic Courtès
2019-06-24 12:22   ` [bug#36351] [PATCH 06/10] derivations: 'derivation' preserves pointer equality Ludovic Courtès
2019-06-24 12:22   ` [bug#36351] [PATCH 07/10] derivations: 'build-derivations' can be passed derivation inputs Ludovic Courtès
2019-06-24 12:22   ` [bug#36351] [PATCH 08/10] packages: 'specification->package+output' distinguishes "no output specified" Ludovic Courtès
2019-06-24 12:22   ` [bug#36351] [PATCH 09/10] ui: 'show-what-to-build' accepts derivation inputs Ludovic Courtès
2019-06-24 12:22   ` [bug#36351] [PATCH 10/10] ui: 'show-derivation-outputs' accepts <derivation-input> records Ludovic Courtès
2019-06-27  9:17 ` bug#36351: [PATCH 00/10] Add 'derivation-build-plan', improve (guix derivations) Ludovic Courtès

Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/guix.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).