home: import: Use (guix read-print) to render the config file.

* guix/scripts/home/import.scm (manifest+configuration-files->code):
Insert calls to 'comment' and 'vertical-space'.
(import-manifest): Use 'pretty-print-with-comments/splice' instead of a
loop on 'pretty-print'.
* tests/home-import.scm (remove-recursively): New procedure.
(eval-test-with-home-environment): Use it.
This commit is contained in:
Ludovic Courtès 2022-09-20 11:58:32 +02:00
parent d0a1e48944
commit 76c58ed59c
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
2 changed files with 25 additions and 7 deletions

View file

@ -26,9 +26,9 @@ (define-module (guix scripts home import)
#:use-module (guix utils) #:use-module (guix utils)
#:use-module (guix packages) #:use-module (guix packages)
#:autoload (guix scripts package) (manifest-entry-version-prefix) #:autoload (guix scripts package) (manifest-entry-version-prefix)
#:use-module (guix read-print)
#:use-module (gnu packages) #:use-module (gnu packages)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (ice-9 pretty-print)
#:use-module (ice-9 rdelim) #:use-module (ice-9 rdelim)
#:use-module (ice-9 regex) #:use-module (ice-9 regex)
#:use-module (ice-9 popen) #:use-module (ice-9 popen)
@ -170,8 +170,19 @@ (define (manifest+configuration-files->code manifest
(gnu services) (gnu services)
,@(delete-duplicates (concatenate modules))) ,@(delete-duplicates (concatenate modules)))
,(vertical-space 1)
(home-environment (home-environment
(packages (specifications->packages ,packages)) ,(comment (G_ "\
;; Below is the list of packages that will show up in your
;; Home profile, under ~/.guix-home/profile.\n"))
(packages
(specifications->packages ,packages))
,(vertical-space 1)
,(comment (G_ "\
;; Below is the list of Home services. To search for available
;; services, run 'guix home search KEYWORD' in a terminal.\n"))
(services (list ,@services))))))))) (services (list ,@services)))))))))
(define* (import-manifest (define* (import-manifest
@ -187,7 +198,5 @@ (define* (import-manifest
;; specifies package names. To reproduce the exact same profile, you also ;; specifies package names. To reproduce the exact same profile, you also
;; need to capture the channels being used, as returned by \"guix describe\". ;; need to capture the channels being used, as returned by \"guix describe\".
;; See the \"Replicating Guix\" section in the manual.\n")) ;; See the \"Replicating Guix\" section in the manual.\n"))
(for-each (lambda (exp)
(newline port) (newline port)
(pretty-print exp port)) (pretty-print-with-comments/splice port exp))))
exp))))

View file

@ -23,6 +23,7 @@ (define-module (test-home-import)
#:use-module (guix build utils) #:use-module (guix build utils)
#:use-module (guix packages) #:use-module (guix packages)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module ((guix read-print) #:select (blank?))
#:use-module ((guix profiles) #:hide (manifest->code)) #:use-module ((guix profiles) #:hide (manifest->code))
#:use-module ((guix build syscalls) #:select (mkdtemp!)) #:use-module ((guix build syscalls) #:select (mkdtemp!))
#:use-module ((guix scripts package) #:use-module ((guix scripts package)
@ -85,13 +86,21 @@ (define (create-file file content)
((file . content) (create-file file content))) ((file . content) (create-file file content)))
files-alist)) files-alist))
(define (remove-recursively pred sexp)
"Like SRFI-1 'remove', but recurse within SEXP."
(let loop ((sexp sexp))
(match sexp
((lst ...)
(map loop (remove pred lst)))
(x x))))
(define (eval-test-with-home-environment files-alist manifest matcher) (define (eval-test-with-home-environment files-alist manifest matcher)
(create-temporary-home files-alist) (create-temporary-home files-alist)
(setenv "HOME" %temporary-home-directory) (setenv "HOME" %temporary-home-directory)
(mkdir-p %temporary-home-directory) (mkdir-p %temporary-home-directory)
(let* ((home-environment (manifest+configuration-files->code (let* ((home-environment (manifest+configuration-files->code
manifest %destination-directory)) manifest %destination-directory))
(result (matcher home-environment))) (result (matcher (remove-recursively blank? home-environment))))
(delete-file-recursively %temporary-home-directory) (delete-file-recursively %temporary-home-directory)
result)) result))