From 3ac8a092fad93754e323f7d9bec2af1a3912b36f Mon Sep 17 00:00:00 2001
From: Ivan Petkov <ivanppetkov@gmail.com>
Date: Tue, 16 Apr 2019 03:37:44 -0700
Subject: [PATCH 1/3] build-system/cargo: expand transitive package inputs

* guix/build/cargo: (package-target-inputs): Add it.
(expand-inputs): Add it.
(expand-native-inputs): Add it.
(package-transitive-dependencies): Add it.
(lower): Use new variables.
---
 guix/build-system/cargo.scm | 105 +++++++++++++++++++++++++++++++++++-
 1 file changed, 103 insertions(+), 2 deletions(-)

diff --git a/guix/build-system/cargo.scm b/guix/build-system/cargo.scm
index dc137421e9..811a044a8c 100644
--- a/guix/build-system/cargo.scm
+++ b/guix/build-system/cargo.scm
@@ -29,6 +29,8 @@
   #:use-module (guix build-system)
   #:use-module (guix build-system gnu)
   #:use-module (ice-9 match)
+  #:use-module (ice-9 vlist)
+  #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
   #:export (%cargo-build-system-modules
             %cargo-utils-modules
@@ -121,6 +123,105 @@ to NAME and VERSION."
                                 #:outputs (cons "src" outputs)
                                 #:guile-for-build guile-for-build))
 
+(define (package-transitive-dependencies inputs)
+  "Return the closure of INPUTS when considering the 'inputs' and
+'propagated-inputs' edges.  Omit duplicate inputs, except for those
+already present in INPUTS itself.
+
+This is implemented as a breadth-first traversal such that INPUTS is
+preserved, and only duplicate extracted inputs are removed.
+
+Forked from ((guix packages) transitive-inputs) since this extraction
+uses slightly different rules compared to the rest of guix (i.e. we
+extract more than just propagated-inputs)."
+  (define (seen? seen item outputs)
+    ;; FIXME: We're using pointer identity here, which is extremely sensitive
+    ;; to memoization in package-producing procedures; see
+    ;; <https://bugs.gnu.org/30155>.
+    (match (vhash-assq item seen)
+      ((_ . o) (equal? o outputs))
+      (_       #f)))
+
+  (let loop ((inputs     inputs)
+             (result     '())
+             (propagated '())
+             (first?     #t)
+             (seen       vlist-null))
+    (match inputs
+      (()
+       (if (null? propagated)
+           (reverse result)
+           (loop (reverse (concatenate propagated)) result '() #f seen)))
+      (((and input (label (? package? package) outputs ...)) rest ...)
+       (if (and (not first?) (seen? seen package outputs))
+           (loop rest result propagated first? seen)
+           (loop rest
+                 (cons input result)
+                 (cons (append (package-inputs package)
+                               (package-propagated-inputs package))
+                       propagated)
+                 first?
+                 (vhash-consq package outputs seen))))
+      ((input rest ...)
+       (loop rest (cons input result) propagated first? seen)))))
+
+(define* (expand-inputs inputs)
+  "Return the transitive target inputs for each package in INPUTS.
+
+Cargo requires all transitive crate dependencies to be available in its index,
+even if they are optional (this is so it can generate deterministic
+Cargo.lock files regardless of the target platform or enabled features).
+
+Rather than burden the package definition to expand these, we'll automate
+that process in the build system."
+  (package-transitive-dependencies inputs))
+
+(define* (expand-native-inputs native-inputs)
+  "Return the transitive target inputs for each package in NATIVE-INPUTS.
+
+We need all transitive crate dependencies for any cargo dev-dependencies,
+but this is only needed when building/testing a crate directly
+(i.e. we will never need transitive dev-dependencies for any dependency
+crates).
+
+In addition, we need to modify any native-inputs to avoid any apparent
+cycles. Cargo does not permit cyclic dependencies between crates, however,
+it permits cycles to occur via dev-dependencies. For example, if crate X
+depends on crate Y, crate Y's tests could pull in crate X to to verify
+everything builds properly (this is a rare scenario, but it it happens for
+example with the `proc-macro2` and `quote` crates). This is allowed by cargo
+because tests are built as a pseudo-crate which happens to depend on the
+X and Y crates, forming an acyclic graph.
+
+Cargo ultimately needs only the crate sources available when doing a build.
+Ultimately, if a cycle is detected, we can break it by replacing the current
+crate we're trying to build with a no-op build which only packages the crate
+source; cargo will then find the source available in its index and build things
+properly."
+  (map
+    (lambda (dep)
+      (match dep
+       ((name input rest ...)
+        ;; TODO: Starting out real simple by ensuring no native-inputs are
+        ;; actually built so we don't accidentally hit a cycle. We can revisit
+        ;; this later and more intelligently replace any dependency on the cycle
+        ;; root with a version of the root with #:skip-build? enabled.
+        ;;
+        ;; Right now this means that if a package shows up in both input
+        ;; and native-input closures, we'll try to build it's src output twice.
+        ;;
+        ;; This also means that we're potentially setting the #:skip-build?
+        ;; flag on non cargo-build-system packages, but this should be okay
+        ;; for now.
+        (let* ((translated-input (package
+                                   (inherit input)
+                                   (inputs '())
+                                   (propagated-inputs '())
+                                   (native-inputs '())
+                                   (arguments '(#:skip-build? #t)))))
+          `(,name ,translated-input ,@rest)))))
+   (package-transitive-dependencies native-inputs)))
+
 (define* (lower name
                 #:key source inputs native-inputs outputs system target
                 (rust (default-rust))
@@ -139,13 +240,13 @@ to NAME and VERSION."
          (host-inputs `(,@(if source
                               `(("source" ,source))
                               '())
-                        ,@inputs
+                        ,@(expand-inputs inputs)
 
                         ;; Keep the standard inputs of 'gnu-build-system'
                         ,@(standard-packages)))
          (build-inputs `(("cargo" ,rust "cargo")
                          ("rustc" ,rust)
-                         ,@native-inputs))
+                         ,@(expand-native-inputs native-inputs)))
          (outputs outputs)
          (build cargo-build)
          (arguments (strip-keyword-arguments private-keywords arguments)))))
-- 
2.21.0

