Package: guix-patches;
Reported by: Xinglu Chen <public <at> yoctocell.xyz>
Date: Tue, 28 Sep 2021 17:34:02 UTC
Severity: normal
Tags: patch
Done: Ludovic Courtès <ludo <at> gnu.org>
Bug is archived. No further changes may be made.
View this message in rfc822 format
From: Xinglu Chen <public <at> yoctocell.xyz> To: 50873 <at> debbugs.gnu.org Cc: Ludovic Courtès <ludo <at> gnu.org>, Andrew Tropin <andrew <at> trop.in> Subject: [bug#50873] [PATCH 1/5] guix home: import: Make the user to specify a destination directory. Date: Tue, 28 Sep 2021 19:35:35 +0200
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.
* 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.
---
guix/scripts/home.scm | 25 +++++++-----
guix/scripts/home/import.scm | 75 +++++++++++++++++++++---------------
2 files changed, 60 insertions(+), 40 deletions(-)
diff --git a/guix/scripts/home.scm b/guix/scripts/home.scm
index 75df6d707d..0f638b643e 100644
--- a/guix/scripts/home.scm
+++ b/guix/scripts/home.scm
@@ -38,6 +38,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)
@@ -248,15 +249,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 79fb23a2fd..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,29 +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")))
+ (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)))))
- '()))))))
-
+ (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)
@@ -66,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?
--
2.33.0
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.