davie/guile-env
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

env:rust: Add launch-rust-analyzer, refactor guix hacks functions

Browse source
This commit is contained in:
Davie Li 2024-01-10 19:56:01 +01:00
parent b00e6e8bf5
commit 92ec57e351
Signed by: davie
GPG key ID: 29FD88532FC91BF4
2 changed files with 56 additions and 44 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

7
env.scm
View file

@ -343,7 +343,7 @@ by other environments made."
(delete "l" (directory-files ".")) (delete "l" (directory-files "."))
(layers-in-use))))) (layers-in-use)))))
(define* (mount-environment env #:optional (tag 'current)) (define* (mount-environment env #:key (tag 'current) target)
(let* ((name (environment-name env)) (let* ((name (environment-name env))
(metadata-dir (metadata-file name)) (metadata-dir (metadata-file name))
(tree (environment-tree env)) (tree (environment-tree env))
@ -361,8 +361,9 @@ by other environments made."
(mkdtemp (string-append (mkdtemp (string-append
"/tmp/env/" (symbol->string name) "/tmp/env/" (symbol->string name)
"." pfix ".XXXXXX")))) "." pfix ".XXXXXX"))))
(merged (let ((f (string-append %env-directory (merged (let ((f (or target
"/" (symbol->string name)))) (string-append %env-directory
"/" (symbol->string name)))))
(if (directory-exists? f) f (mkdir-p f)))) (if (directory-exists? f) f (mkdir-p f))))
(upper (mkdtemp* "upper")) (upper (mkdtemp* "upper"))
(work (mkdtemp* "work")) (work (mkdtemp* "work"))

93
env/rust.scm vendored
View file

@ -1,4 +1,5 @@
(define-module (env rust) (define-module (env rust)
#:use-module (env)
#:use-module (gnu packages) #:use-module (gnu packages)
#:use-module (gnu packages base) #:use-module (gnu packages base)
#:use-module (gnu packages bash) #:use-module (gnu packages bash)
@ -10,6 +11,7 @@
#:use-module (gnu packages commencement) #:use-module (gnu packages commencement)
#:use-module (gnu packages compression) #:use-module (gnu packages compression)
#:use-module (gnu system file-systems) #:use-module (gnu system file-systems)
#:use-module (guix build utils)
#:use-module (guix download) #:use-module (guix download)
#:use-module (guix git-download) #:use-module (guix git-download)
#:use-module ((guix licenses) #:prefix license:) #:use-module ((guix licenses) #:prefix license:)
@ -23,7 +25,8 @@
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:export (launch-rustup-environment #:export (launch-rustup-environment
init-rustup-environment)) init-rustup-environment
launch-rust-analyzer))
(define rustup-origin (define rustup-origin
(let ((name "rustup") (let ((name "rustup")
@ -69,36 +72,6 @@
0 7)) 0 7))
(item rustup-init-script-derivation))))) (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) (define (call-with-guix-shell-hacks proc)
"Overcome several pitfails calling launch-environment/container procedure we "Overcome several pitfails calling launch-environment/container procedure we
aren't supposed to. PROC is passed curried launch-environment/container aren't supposed to. PROC is passed curried launch-environment/container
@ -136,16 +109,54 @@ function."
;; Why not? ;; Why not?
(flush-all-ports))))) (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) (define* (init-rustup-environment #:optional home)
(call-with-guix-shell-hacks (exec-in-rustup-environment '("rustup-init.sh" "-q" "-y") #:home home))
(λ (launch)
(exec-in-rustup-environment launch
'("rustup-init.sh" "-q" "-y")
home))))
(define* (launch-rustup-environment #:optional home) (define* (launch-rustup-environment #:optional home)
(call-with-guix-shell-hacks (exec-in-rustup-environment '("/bin/sh") #:home home))
(λ (launch)
(exec-in-rustup-environment launch (define* (launch-rust-analyzer env target-name
'("/bin/sh") #:key (tag 'current) mappings)
home)))) (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)))))