Message ID | 9db0424f9494d3d15e534eb75773ae9bd3f33cb3.1633861021.git.public@yoctocell.xyz |
---|---|
State | Accepted |
Headers | show |
Series | Fixes to ‘guix home import’ | expand |
Context | Check | Description |
---|---|---|
cbaines/comparison | success | View comparision |
cbaines/git branch | success | View Git branch |
cbaines/applying patch | success | View Laminar job |
cbaines/issue | success | View issue |
cbaines/comparison | success | View comparision |
cbaines/git branch | success | View Git branch |
cbaines/applying patch | success | View Laminar job |
cbaines/issue | success | View issue |
cbaines/comparison | success | View comparision |
cbaines/git branch | success | View Git branch |
cbaines/applying patch | success | View Laminar job |
cbaines/issue | success | View issue |
cbaines/comparison | success | View comparision |
cbaines/git branch | success | View Git branch |
cbaines/applying patch | success | View Laminar job |
cbaines/issue | success | View issue |
cbaines/comparison | success | View comparision |
cbaines/git branch | success | View Git branch |
cbaines/comparison | success | View comparision |
cbaines/git branch | success | View Git branch |
cbaines/applying patch | success | View Laminar job |
cbaines/issue | success | View issue |
cbaines/applying patch | success | View Laminar job |
cbaines/issue | success | View issue |
Hello, Xinglu Chen <public@yoctocell.xyz> skribis: > Copy the appropriate the relevant configuration files to the destination > directory, and call ‘local-file’ on them. > > Without this, ‘guix home import’ will generate a service declaration like this > > (service > home-bash-service-type > (home-bash-configuration > (bashrc > (list (slurp-file-gexp > (local-file "/home/yoctocell/.bashrc")))))) > > but when running ‘guix home reconfigure’, the ~/.bashrc file would be moved, so > when running ‘guix home reconfigure’ for the second time, it would read the > ~/.bashrc which is itself a symlink to a file the store. Ooh, good catch! > * guix/scripts/home/import.scm (%destination-directory): New parameter. > (generate-bash-module+configuration): Adjust accordingly. > (modules+configurations): Copy the user’s configuration file to > ‘%destination-directory’. > * guix/scripts/home.scm (process-command): Adjust accordingly; create > ‘%destination-directory’ if it doesn’t exist. [...] > +(define %destination-directory > + (make-parameter (string-append (getenv "HOME") "/src/guix-config"))) Instead of making it a parameter, with a default value that looks fishy but is never actually used :-), can we make it an explicit parameter of ‘generate-bash-module+configuration’? Otherwise LGTM! Thanks, Ludo’.
Hi, (sorry for taking so long to get to this!) On Wed, Oct 13 2021, Ludovic Courtès wrote: > Hello, > > Xinglu Chen <public@yoctocell.xyz> skribis: > >> Copy the appropriate the relevant configuration files to the destination >> directory, and call ‘local-file’ on them. >> >> Without this, ‘guix home import’ will generate a service declaration like this >> >> (service >> home-bash-service-type >> (home-bash-configuration >> (bashrc >> (list (slurp-file-gexp >> (local-file "/home/yoctocell/.bashrc")))))) >> >> but when running ‘guix home reconfigure’, the ~/.bashrc file would be moved, so >> when running ‘guix home reconfigure’ for the second time, it would read the >> ~/.bashrc which is itself a symlink to a file the store. > > Ooh, good catch! > >> * guix/scripts/home/import.scm (%destination-directory): New parameter. >> (generate-bash-module+configuration): Adjust accordingly. >> (modules+configurations): Copy the user’s configuration file to >> ‘%destination-directory’. >> * guix/scripts/home.scm (process-command): Adjust accordingly; create >> ‘%destination-directory’ if it doesn’t exist. > > [...] > >> +(define %destination-directory >> + (make-parameter (string-append (getenv "HOME") "/src/guix-config"))) > > Instead of making it a parameter, with a default value that looks fishy > but is never actually used :-), can we make it an explicit parameter of > ‘generate-bash-module+configuration’? Ah, that would be a good idea. :-)
diff --git a/guix/scripts/home.scm b/guix/scripts/home.scm index 55e7b436c1..520360e14a 100644 --- a/guix/scripts/home.scm +++ b/guix/scripts/home.scm @@ -40,6 +40,7 @@ (define-module (guix scripts home) #:autoload (guix scripts pull) (channel-commit-hyperlink) #:use-module (guix scripts home import) #:use-module ((guix status) #:select (with-status-verbosity)) + #:use-module ((guix build utils) #:select (mkdir-p)) #:use-module (guix gexp) #:use-module (guix monads) #:use-module (srfi srfi-1) @@ -260,15 +261,21 @@ (define-syntax-rule (with-store* store exp ...) (apply search args)) ((import) (let* ((profiles (delete-duplicates - (match (filter-map (match-lambda - (('profile . p) p) - (_ #f)) - opts) - (() (list %current-profile)) - (lst (reverse lst))))) - (manifest (concatenate-manifests - (map profile-manifest profiles)))) - (import-manifest manifest (current-output-port)))) + (match (filter-map (match-lambda + (('profile . p) p) + (_ #f)) + opts) + (() (list %current-profile)) + (lst (reverse lst))))) + (manifest (concatenate-manifests + (map profile-manifest profiles))) + (destination (match args + ((destination) destination) + (_ (leave (G_ "wrong number of arguments~%")))))) + (unless (file-exists? destination) + (mkdir-p destination)) + (parameterize ((%destination-directory destination)) + (import-manifest manifest (current-output-port))))) ((describe) (match (generation-number %guix-home) (0 diff --git a/guix/scripts/home/import.scm b/guix/scripts/home/import.scm index 611f580e85..a6ab68a32c 100644 --- a/guix/scripts/home/import.scm +++ b/guix/scripts/home/import.scm @@ -27,7 +27,8 @@ (define-module (guix scripts home import) #:use-module (ice-9 pretty-print) #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) - #:export (import-manifest)) + #:export (import-manifest + %destination-directory)) ;;; Commentary: ;;; @@ -36,27 +37,34 @@ (define-module (guix scripts home import) ;;; ;;; Code: +(define %destination-directory + (make-parameter (string-append (getenv "HOME") "/src/guix-config"))) (define (generate-bash-module+configuration) - (let ((rc (string-append (getenv "HOME") "/.bashrc")) - (profile (string-append (getenv "HOME") "/.bash_profile")) - (logout (string-append (getenv "HOME") "/.bash_logout"))) - `((gnu home services bash) - (service home-bash-service-type - (home-bash-configuration - ,@(if (file-exists? rc) - `((bashrc - (list (local-file ,rc)))) - '()) - ,@(if (file-exists? profile) - `((bash-profile - (list (local-file ,profile)))) - '()) - ,@(if (file-exists? logout) - `((bash-logout - (list (local-file ,logout)))) - '())))))) + (define (destination-append path) + (string-append (%destination-directory) "/" path)) + (let ((rc (destination-append ".bashrc")) + (profile (destination-append ".bash_profile")) + (logout (destination-append ".bash_logout"))) + `((gnu home-services bash) + (service home-bash-service-type + (home-bash-configuration + ,@(if (file-exists? rc) + `((bashrc + (list (slurp-file-gexp + (local-file ,rc))))) + '()) + ,@(if (file-exists? profile) + `((bash-profile + (list (slurp-file-gexp + (local-file ,profile))))) + '()) + ,@(if (file-exists? logout) + `((bash-logout + (list (slurp-file-gexp + (local-file ,logout))))) + '())))))) (define %files-configurations-alist `((".bashrc" . ,generate-bash-module+configuration) @@ -64,17 +72,24 @@ (define %files-configurations-alist (".bash_logout" . ,generate-bash-module+configuration))) (define (modules+configurations) - (let ((configurations (delete-duplicates - (filter-map (match-lambda - ((file . proc) - (if (file-exists? - (string-append (getenv "HOME") "/" file)) - proc - #f))) - %files-configurations-alist) - (lambda (x y) - (equal? (procedure-name x) (procedure-name y)))))) - (map (lambda (proc) (proc)) configurations))) + (define configurations + (delete-duplicates + (filter-map (match-lambda + ((file . proc) + (let ((absolute-path (string-append (getenv "HOME") + "/" file))) + (if (file-exists? absolute-path) + (begin + (copy-file absolute-path + (string-append + (%destination-directory) "/" file)) + proc) + #f)))) + %files-configurations-alist) + (lambda (x y) + (equal? (procedure-name x) (procedure-name y))))) + + (map (lambda (proc) (proc)) configurations)) ;; Based on `manifest->code' from (guix profiles) ;; MAYBE: Upstream it?