TakeV/guix
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

guix home: import: Make the user to specify a destination directory.

Browse source 
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 (generate-bash-module+configuration): Take
‘destination-directory’ parameter
(modules+configurations): Copy the user’s configuration file to
‘%destination-directory’.
* guix/scripts/home.scm (process-command): Adjust accordingly; create
‘destination’ if it doesn’t exist.

Signed-off-by: Ludovic Courtès <ludo@gnu.org>
This commit is contained in:
Xinglu Chen 2021-10-30 12:42:27 +02:00 committed by Ludovic Courtès
parent cf0abb6cfe
commit d5eb05f01e
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
2 changed files with 65 additions and 45 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

24
guix/scripts/home.scm
View file

@ -40,6 +40,7 @@ (define-module (guix scripts home)
#:autoload (guix scripts pull) (channel-commit-hyperlink) #:autoload (guix scripts pull) (channel-commit-hyperlink)
#:use-module (guix scripts home import) #:use-module (guix scripts home import)
#:use-module ((guix status) #:select (with-status-verbosity)) #:use-module ((guix status) #:select (with-status-verbosity))
#:use-module ((guix build utils) #:select (mkdir-p))
#:use-module (guix gexp) #:use-module (guix gexp)
#:use-module (guix monads) #:use-module (guix monads)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
@ -260,15 +261,20 @@ (define-syntax-rule (with-store* store exp ...)
(apply search args)) (apply search args))
((import) ((import)
(let* ((profiles (delete-duplicates (let* ((profiles (delete-duplicates
(match (filter-map (match-lambda (match (filter-map (match-lambda
(('profile . p) p) (('profile . p) p)
(_ #f)) (_ #f))
opts) opts)
(() (list %current-profile)) (() (list %current-profile))
(lst (reverse lst))))) (lst (reverse lst)))))
(manifest (concatenate-manifests (manifest (concatenate-manifests
(map profile-manifest profiles)))) (map profile-manifest profiles)))
(import-manifest manifest (current-output-port)))) (destination (match args
((destination) destination)
(_ (leave (G_ "wrong number of arguments~%"))))))
(unless (file-exists? destination)
(mkdir-p destination))
(import-manifest manifest destination (current-output-port))))
((describe) ((describe)
(match (generation-number %guix-home) (match (generation-number %guix-home)
(0 (0

86
guix/scripts/home/import.scm
View file

@ -36,49 +36,61 @@ (define-module (guix scripts home import)
;;; ;;;
;;; Code: ;;; Code:
(define (generate-bash-configuration+modules destination-directory)
(define (destination-append path)
(string-append destination-directory "/" path))
(define (generate-bash-module+configuration) (let ((rc (destination-append ".bashrc"))
(let ((rc (string-append (getenv "HOME") "/.bashrc")) (profile (destination-append ".bash_profile"))
(profile (string-append (getenv "HOME") "/.bash_profile")) (logout (destination-append ".bash_logout")))
(logout (string-append (getenv "HOME") "/.bash_logout"))) `((gnu home-services bash)
`((gnu home services bash)
(service home-bash-service-type (service home-bash-service-type
(home-bash-configuration (home-bash-configuration
,@(if (file-exists? rc) ,@(if (file-exists? rc)
`((bashrc `((bashrc
(list (local-file ,rc)))) (list (slurp-file-gexp
'()) (local-file ,rc)))))
,@(if (file-exists? profile) '())
`((bash-profile ,@(if (file-exists? profile)
(list (local-file ,profile)))) `((bash-profile
'()) (list (slurp-file-gexp
,@(if (file-exists? logout) (local-file ,profile)))))
`((bash-logout '())
(list (local-file ,logout)))) ,@(if (file-exists? logout)
'())))))) `((bash-logout
(list (slurp-file-gexp
(local-file ,logout)))))
'()))))))
(define %files-configurations-alist (define %files-configurations-alist
`((".bashrc" . ,generate-bash-module+configuration) `((".bashrc" . ,generate-bash-module+configuration)
(".bash_profile" . ,generate-bash-module+configuration) (".bash_profile" . ,generate-bash-module+configuration)
(".bash_logout" . ,generate-bash-module+configuration))) (".bash_logout" . ,generate-bash-module+configuration)))
(define (modules+configurations) (define (configurations+modules destination-directory)
(let ((configurations (delete-duplicates "Return a list of procedures which when called, generate code for a home
(filter-map (match-lambda service declaration."
((file . proc) (define configurations
(if (file-exists? (delete-duplicates
(string-append (getenv "HOME") "/" file)) (filter-map (match-lambda
proc ((file . proc)
#f))) (let ((absolute-path (string-append (getenv "HOME")
%files-configurations-alist) "/" file)))
(lambda (x y) (and (file-exists? absolute-path)
(equal? (procedure-name x) (procedure-name y)))))) (begin
(map (lambda (proc) (proc)) configurations))) (copy-file absolute-path
(string-append
destination-directory "/" file))
proc)))))
%files+configurations-alist)
(lambda (x y)
(equal? (procedure-name x) (procedure-name y)))))
(map (lambda (proc) (proc destination-directory)) configurations))
;; Based on `manifest->code' from (guix profiles) ;; Based on `manifest->code' from (guix profiles)
;; MAYBE: Upstream it? ;; MAYBE: Upstream it?
(define* (manifest->code manifest (define* (manifest->code manifest destination-directory
#:key #:key
(entry-package-version (const "")) (entry-package-version (const ""))
(home-environment? #f)) (home-environment? #f))
@ -129,7 +141,8 @@ (define (qualified-name entry)
":" output)))) ":" output))))
(manifest-entries manifest)))) (manifest-entries manifest))))
(if home-environment? (if home-environment?
(let ((modules+configurations (modules+configurations))) (let ((configurations+modules
(configurations+modules destination-directory)))
`(begin `(begin
(use-modules (gnu home) (use-modules (gnu home)
(gnu packages) (gnu packages)
@ -171,7 +184,8 @@ (define name
(options->transformation ',options)))) (options->transformation ',options))))
transformation-procedures))) transformation-procedures)))
(if home-environment? (if home-environment?
(let ((modules+configurations (modules+configurations))) (let ((configurations+modules
(configurations+modules destination-directory)))
`(begin `(begin
(use-modules (guix transformations) (use-modules (guix transformations)
(gnu home) (gnu home)
@ -204,7 +218,7 @@ (define* (home-environment-template #:key (packages #f) (specs #f) services)
(services (list ,@services)))) (services (list ,@services))))
(define* (import-manifest (define* (import-manifest
manifest manifest destination-directory
#:optional (port (current-output-port))) #:optional (port (current-output-port)))
"Write to PORT a <home-environment> corresponding to MANIFEST." "Write to PORT a <home-environment> corresponding to MANIFEST."
(define (version-spec entry) (define (version-spec entry)
@ -227,7 +241,7 @@ (define (version-spec entry)
(version-unique-prefix (manifest-entry-version entry) (version-unique-prefix (manifest-entry-version entry)
versions))))))) versions)))))))
(match (manifest->code manifest (match (manifest->code manifest destination-directory
#:entry-package-version version-spec #:entry-package-version version-spec
#:home-environment? #t) #:home-environment? #t)
(('begin exp ...) (('begin exp ...)