[bug#49149] [PATCH] tentatively reuse rlib for cargo-build-system

[Maxim Cournoyer]

---
 guix/build-system/cargo.scm       |  3 +-
 guix/build/cargo-build-system.scm | 78 ++++++++++++++++++++++++++-----
 2 files changed, 68 insertions(+), 13 deletions(-)

diff --git a/guix/build-system/cargo.scm b/guix/build-system/cargo.scm
index e53d2a7523..9ef9f6b149 100644
--- a/guix/build-system/cargo.scm
+++ b/guix/build-system/cargo.scm
@@ -271,7 +271,8 @@ any dependent crates. This can be a benefits:
          (build-inputs `(("cargo" ,rust "cargo")
                          ("rustc" ,rust)
                          ,@(expand-crate-sources cargo-inputs 
cargo-development-inputs)
-                         ,@native-inputs))
+                         ,@native-inputs
+                        ,@(if target '() inputs)))
          (outputs outputs)
          (build cargo-build)
          (arguments (strip-keyword-arguments private-keywords arguments)))))
diff --git a/guix/build/cargo-build-system.scm 
b/guix/build/cargo-build-system.scm
index 0a95672b00..e68f20e463 100644
--- a/guix/build/cargo-build-system.scm
+++ b/guix/build/cargo-build-system.scm
@@ -5,6 +5,7 @@
 ;;; Copyright © 2019, 2020, 2021 Efraim Flashner <efraim@flashner.co.il>
 ;;; Copyright © 2020 Jakub Kądziołka <kuba@kadziolka.net>
 ;;; Copyright © 2020 Marius Bakke <marius@gnu.org>
+;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -24,7 +25,7 @@
 (define-module (guix build cargo-build-system)
   #:use-module ((guix build gnu-build-system) #:prefix gnu:)
   #:use-module (guix build json)
-  #:use-module (guix build utils)
+  #:use-module ((guix build utils) #:hide (delete))
   #:use-module (guix build cargo-utils)
   #:use-module (ice-9 popen)
   #:use-module (ice-9 rdelim)
@@ -34,7 +35,10 @@
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
   #:export (%standard-phases
-            cargo-build))
+            cargo-build
+
+            rust-version
+            rust-library-prefix))
 
 ;; Commentary:
 ;;
@@ -42,6 +46,25 @@
 ;;
 ;; Code:
 
+(define (rust-version rust)
+  "Return the version triplet (major.minor.patch) as a string, given RUST, a
+store file name."
+  (let* ((version     (last (string-split rust #\-)))
+         (components  (string-split version #\.))
+         (major+minor+patch (take components 3)))
+    (string-join major+minor+patch ".")))
+
+(define (rust-library-prefix/relative inputs)
+  "Return the relative versioned Rust library prefix where Rust libraries are
+to be installed."
+  (string-append "lib/rust/" (rust-version (assoc-ref inputs "rustc"))))
+
+(define (rust-library-prefix inputs outputs)
+  "Return the absolute versioned Rust library prefix where Rust libraries are
+to be installed."
+  (string-append (assoc-ref outputs "out") "/"
+                 (rust-library-prefix/relative inputs)))
+
 (define (manifest-targets)
   "Extract all targets from the Cargo.toml manifest"
   (let* ((port (open-input-pipe "cargo read-manifest"))
@@ -73,6 +96,16 @@ Cargo.toml file present at its root."
                                             " | cut -d/ -f2"
                                             " | grep -q '^Cargo.toml$'")))))
 
+(define (rlib? file)
+  "Check if FILE has the .rlib extension."
+  (string-suffix? ".rlib" file))
+
+(define (inputs->directories inputs)
+  "Extract the directory part from INPUTS."
+  (match inputs
+    (((names . directories) ...)
+     directories)))
+
 (define* (unpack-rust-crates #:key inputs vendor-dir #:allow-other-keys)
   (define (inputs->rust-inputs inputs)
     "Filter using the label part from INPUTS."
@@ -80,11 +113,6 @@ Cargo.toml file present at its root."
               (match input
                 ((name . _) (rust-package? name))))
             inputs))
-  (define (inputs->directories inputs)
-    "Extract the directory part from INPUTS."
-    (match inputs
-      (((names . directories) ...)
-       directories)))
 
   (let ((rust-inputs (inputs->directories (inputs->rust-inputs inputs))))
     (unless (null? rust-inputs)
@@ -185,6 +213,22 @@ directory = '" port)
   (generate-all-checksums vendor-dir)
   #t)
 
+(define* (populate-cargo-cache #:key inputs outputs #:allow-other-keys)
+  "Populate the 'target/release' directory with any pre-built Rust libraries,
+to avoid rebuilding them from sources when possible."
+  (let* ((rust-lib-prefix (rust-library-prefix/relative inputs))
+         (input-dirs (inputs->directories inputs))
+         (rust-lib-dirs (filter (lambda (f)
+                                  (file-exists? (string-append
+                                                 f "/" rust-lib-prefix)))
+                                input-dirs))
+         (rlibs (delete-duplicates (append-map (cut find-files <> "\\.rlib$")
+                                               rust-lib-dirs))))
+    (pk 'rust-lib-dirs rust-lib-dirs)
+    (pk 'rlibs rlibs)
+    (for-each (cut install-file <> "target/release") rlibs)
+    (invoke "find" "target")))
+
 (define* (build #:key
                 skip-build?
                 (features '())
@@ -228,7 +272,9 @@ directory = '" port)
   "Install a given Cargo package."
   (let* ((out      (assoc-ref outputs "out"))
          (registry (string-append out "/share/cargo/registry"))
-         (sources  (string-append out "/share/cargo/src")))
+         (sources  (string-append out "/share/cargo/src"))
+         (libdir   (rust-library-prefix inputs outputs))
+         (release-dir "target/release"))
     (mkdir-p out)
 
     ;; Make cargo reuse all the artifacts we just built instead
@@ -237,10 +283,17 @@ directory = '" port)
 
     ;; Only install crates which include binary targets,
     ;; otherwise cargo will raise an error.
-    (or skip-build?
-        (not (has-executable-target?))
-        (invoke "cargo" "install" "--no-track" "--path" "." "--root" out
-                "--features" (string-join features)))
+    (unless skip-build?
+      ;; Install binaries.
+      (when (has-executable-target?)
+        (apply invoke "cargo" "install" "--no-track" "--path" "." "--root" out
+               (if (not (null? features))
+                   (list "--features" (string-join features))
+                   '())))
+      ;; Install static libraries.
+      (for-each (lambda (file)
+                  (install-file (string-append release-dir "/" file) libdir))
+                (scandir release-dir (cut string-suffix? ".rlib" <>))))
 
     (when install-source?
       ;; Install crate tarballs and unpacked sources for later use.
@@ -260,6 +313,7 @@ directory = '" port)
   (modify-phases gnu:%standard-phases
     (delete 'bootstrap)
     (replace 'configure configure)
+    (add-before 'build 'populate-cargo-cache populate-cargo-cache)
     (replace 'build build)
     (replace 'check check)
     (replace 'install install)
-- 
2.31.1