From 92ec57e351df3adc1de74c8d22183abd907e5276 Mon Sep 17 00:00:00 2001
From: Davie Li <hello@davie.li>
Date: Wed, 10 Jan 2024 19:56:01 +0100
Subject: [PATCH] env:rust: Add launch-rust-analyzer, refactor guix hacks
 functions

---
 env.scm      |  7 ++--
 env/rust.scm | 93 +++++++++++++++++++++++++++++-----------------------
 2 files changed, 56 insertions(+), 44 deletions(-)

diff --git a/env.scm b/env.scm
index c2ac7d9..f6162b5 100644
--- a/env.scm
+++ b/env.scm
@@ -343,7 +343,7 @@ by other environments made."
                (delete "l" (directory-files "."))
                (layers-in-use)))))
 
-(define* (mount-environment env #:optional (tag 'current))
+(define* (mount-environment env #:key (tag 'current) target)
   (let* ((name (environment-name env))
          (metadata-dir (metadata-file name))
          (tree (environment-tree env))
@@ -361,8 +361,9 @@ by other environments made."
               (mkdtemp (string-append
                         "/tmp/env/" (symbol->string name)
                         "." pfix ".XXXXXX"))))
-           (merged (let ((f (string-append %env-directory
-                                           "/" (symbol->string name))))
+           (merged (let ((f (or target
+                                (string-append %env-directory
+                                               "/" (symbol->string name)))))
                      (if (directory-exists? f) f (mkdir-p f))))
            (upper  (mkdtemp* "upper"))
            (work   (mkdtemp* "work"))
diff --git a/env/rust.scm b/env/rust.scm
index ac2f86b..9044b72 100644
--- a/env/rust.scm
+++ b/env/rust.scm
@@ -1,4 +1,5 @@
 (define-module (env rust)
+  #:use-module (env)
   #:use-module (gnu packages)
   #:use-module (gnu packages base)
   #:use-module (gnu packages bash)
@@ -10,6 +11,7 @@
   #:use-module (gnu packages commencement)
   #:use-module (gnu packages compression)
   #:use-module (gnu system file-systems)
+  #:use-module (guix build utils)
   #:use-module (guix download)
   #:use-module (guix git-download)
   #:use-module ((guix licenses) #:prefix license:)
@@ -23,7 +25,8 @@
   #:use-module (ice-9 match)
   #:use-module (srfi srfi-1)
   #:export (launch-rustup-environment
-            init-rustup-environment))
+            init-rustup-environment
+            launch-rust-analyzer))
 
 (define rustup-origin
   (let ((name "rustup")
@@ -69,36 +72,6 @@
                           0 7))
       (item rustup-init-script-derivation)))))
 
-(define* (exec-in-rustup-environment launch cmd #:optional home)
-  (let* ((mappings  (if home
-                        (list
-                         (file-system-mapping
-                          (source home)
-                          (target "/home/rustup")
-                          (writable? #t)))
-                        '())))
-    (with-store store
-      (run-with-store store
-        (mlet* %store-monad ((bash (package->derivation bash))
-                             (profile (profile-derivation
-                                       rustup-environment-manifest)))
-          (mbegin %store-monad
-            (built-derivations (list bash profile))
-            (let ((bash-binary (string-append (derivation->output-path bash)
-                                              "/bin/sh"))
-                  (profile-dir (derivation->output-path profile)))
-              (launch #:command cmd
-                      #:bash bash-binary
-                      #:user "rustup"
-                      #:user-mappings mappings
-                      #:profile profile-dir
-                      #:manifest rustup-environment-manifest
-                      #:link-profile? #f
-                      #:network? #t
-                      #:map-cwd? #f
-                      #:emulate-fhs? #t
-                      #:nesting? #f))))))))
-
 (define (call-with-guix-shell-hacks proc)
   "Overcome several pitfails calling launch-environment/container procedure we
 aren't supposed to.  PROC is passed curried launch-environment/container
@@ -136,16 +109,54 @@ function."
            ;; Why not?
            (flush-all-ports)))))
 
+(define* (exec-in-rustup-environment cmd #:key home mappings)
+  (let* ((mappings (append (if home
+                               (list (file-system-mapping
+                                      (source home)
+                                      (target "/home/rustup")
+                                      (writable? #t)))
+                               '())
+                           mappings)))
+    (call-with-guix-shell-hacks
+     (λ (launch)
+       (with-store store
+         (run-with-store store
+           (mlet* %store-monad ((bash (package->derivation bash))
+                                (profile (profile-derivation
+                                          rustup-environment-manifest)))
+             (mbegin %store-monad
+               (built-derivations (list bash profile))
+               (let ((bash-binary (string-append (derivation->output-path bash)
+                                                 "/bin/sh"))
+                     (profile-dir (derivation->output-path profile)))
+                 (launch #:command cmd
+                         #:bash bash-binary
+                         #:user "rustup"
+                         #:user-mappings mappings
+                         #:profile profile-dir
+                         #:manifest rustup-environment-manifest
+                         #:link-profile? #f
+                         #:network? #t
+                         #:map-cwd? #f
+                         #:emulate-fhs? #t
+                         #:nesting? #f))))))))))
+
 (define* (init-rustup-environment #:optional home)
-  (call-with-guix-shell-hacks
-   (λ (launch)
-     (exec-in-rustup-environment launch
-                                 '("rustup-init.sh" "-q" "-y")
-                                 home))))
+  (exec-in-rustup-environment '("rustup-init.sh" "-q" "-y") #:home home))
 
 (define* (launch-rustup-environment #:optional home)
-  (call-with-guix-shell-hacks
-   (λ (launch)
-     (exec-in-rustup-environment launch
-                                 '("/bin/sh")
-                                 home))))
+  (exec-in-rustup-environment '("/bin/sh") #:home home))
+
+(define* (launch-rust-analyzer env target-name
+                               #:key (tag 'current) mappings)
+  (let* ((target (string-append (@@ (env) %env-directory) "/" target-name))
+         (mnt (mount-environment env #:tag tag #:target target)))
+    (exec-in-rustup-environment '("./.cargo/bin/rust-analyzer")
+                                #:home (overlay-mount-merged mnt)
+                                #:mappings mappings)
+    (sync)
+    (system* "umount" target)
+    (for-each delete-file-recursively
+              (list target
+                    (overlay-mount-upper mnt)
+                    (overlay-mount-work mnt)))))