[bug#42049] [PATCH 1/4] build-system/cargo: Allow propagating inputs across CARGO-INPUTS edges

[Jakub Kądziołka]

* guix/build-system/cargo.scm (package-propagated-native-inputs):
  New procedure.
  (expand-crate-sources): Take crate closure instead of input lists.
  (lower): Expand host-inputs and build-inputs to include inputs
  from the crate closure.
---
 guix/build-system/cargo.scm | 59 +++++++++++++++++++++++--------------
 1 file changed, 37 insertions(+), 22 deletions(-)

diff --git a/guix/build-system/cargo.scm b/guix/build-system/cargo.scm
index 6c8edf6bac..3f518343ec 100644
--- a/guix/build-system/cargo.scm
+++ b/guix/build-system/cargo.scm
@@ -143,6 +143,12 @@ to NAME and VERSION."
       cargo-development-inputs)
     (package-arguments p)))
 
+(define (package-propagated-native-inputs p)
+  (apply
+    (lambda* (#:key (propagated-native-inputs '()) #:allow-other-keys)
+      propagated-native-inputs)
+    (package-arguments p)))
+
 (define (crate-closure inputs)
   "Return the closure of INPUTS when considering the 'cargo-inputs' and
 'cargod-dev-deps' edges.  Omit duplicate inputs, except for those
@@ -182,9 +188,8 @@ do not extract the conventional inputs)."
       ((input rest ...)
        (loop rest (cons input result) propagated first? seen)))))
 
-(define (expand-crate-sources cargo-inputs cargo-development-inputs)
-  "Extract all transitive sources for CARGO-INPUTS and CARGO-DEVELOPMENT-INPUTS
-along their 'cargo-inputs' edges.
+(define (expand-crate-sources crate-closure)
+  "Extract all sources for the transitive cargo inputs provided in 
CRATE-CLOSURE.
 
 Cargo requires all transitive crate dependencies' sources to be available
 in its index, even if they are optional (this is so it can generate
@@ -236,40 +241,50 @@ any dependent crates. This can be a benefits:
        (list label (package-source p)))
       ((label input)
        (list label input)))
-    (crate-closure (append cargo-inputs cargo-development-inputs))))
+    crate-closure))
 
 (define* (lower name
                 #:key source inputs native-inputs outputs system target
                 (rust (default-rust))
                 (cargo-inputs '())
                 (cargo-development-inputs '())
+                (propagated-native-inputs '())
                 #:allow-other-keys
                 #:rest arguments)
   "Return a bag for NAME."
 
   (define private-keywords
     '(#:source #:target #:rust #:inputs #:native-inputs #:outputs
-      #:cargo-inputs #:cargo-development-inputs))
+      #:cargo-inputs #:cargo-development-inputs #:propagated-native-inputs))
 
   (and (not target) ;; TODO: support cross-compilation
-       (bag
-         (name name)
-         (system system)
-         (target target)
-         (host-inputs `(,@(if source
-                              `(("source" ,source))
-                              '())
-                        ,@inputs
+       (let ((closure (crate-closure
+                        (append cargo-inputs cargo-development-inputs))))
+         (bag
+           (name name)
+           (system system)
+           (target target)
+           (host-inputs `(,@(if source
+                                `(("source" ,source))
+                                '())
+                          ,@inputs
+                          ,@(append-map
+                              (compose package-propagated-inputs second)
+                              closure)
 
-                        ;; Keep the standard inputs of 'gnu-build-system'
-                        ,@(standard-packages)))
-         (build-inputs `(("cargo" ,rust "cargo")
-                         ("rustc" ,rust)
-                         ,@(expand-crate-sources cargo-inputs 
cargo-development-inputs)
-                         ,@native-inputs))
-         (outputs outputs)
-         (build cargo-build)
-         (arguments (strip-keyword-arguments private-keywords arguments)))))
+                          ;; Keep the standard inputs of 'gnu-build-system'
+                          ,@(standard-packages)))
+           (build-inputs `(("cargo" ,rust "cargo")
+                           ("rustc" ,rust)
+                           ,@(expand-crate-sources closure)
+                           ,@(append-map
+                               (compose package-propagated-native-inputs 
second)
+                               closure)
+                           ,@propagated-native-inputs
+                           ,@native-inputs))
+           (outputs outputs)
+           (build cargo-build)
+           (arguments (strip-keyword-arguments private-keywords arguments))))))
 
 (define cargo-build-system
   (build-system
-- 
2.26.2