Package: guix-patches;
Reported by: goodoldpaul <at> autistici.org
Date: Tue, 3 Jan 2023 16:53:02 UTC
Severity: normal
Tags: moreinfo, 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: Ludovic Courtès <ludo <at> gnu.org> To: Giacomo Leidi <goodoldpaul <at> autistici.org> Cc: 60521 <at> debbugs.gnu.org Subject: [bug#60521] [PATCH v6] home: Add home-dotfiles-service. Date: Sat, 27 Jan 2024 23:56:29 +0100
[Message part 1 (text/plain, inline)]
Hi Giacomo,
Giacomo Leidi <goodoldpaul <at> autistici.org> skribis:
> * gnu/home/services.scm (dotfiles-for-app): New variable;
> (home-dotfiles-configuration): new variable;
> (home-dotfiles-service-type): new variable.
> * doc/guix.texi: Document it.
Apologies again for the long delay.
The patch looks great to me and I think the functionality is there.
I gave it a try for my own config, and that has led me to make the
attached changes, which can be summarized as follows:
• The dotfile directories are resolved relative the source location
where ‘home-dotfiles-configuration’ appears. The advantage is that
users do not need to fiddle with (current-source-directory).
• As a consequence, all ‘with-directory-excursion’ and
‘canonicalize-path’ calls are gone. (Those should only be used with
great care.)
• The dotfile directories are traversed only once, using ‘find-files’.
• The exclusion regexp is compiled only once (with ‘make-regexp’) and
then reused (with ‘regexp-exec’ calls), which is more efficient
than repeated ‘string-match’ calls.
• Use ‘string-map’ instead of ‘string-replace-substring’ (it’s simpler
and more efficient).
If that’s fine with you, please feel free to apply these changes.
One last thing I should have suggested earlier: how about moving it to
(gnu home services dotfiles)? That would keep the scope of (gnu home
services) limited to essential services.
Please send one last version when you’re ready; I’m eager to use it for
my own config actually. :-)
Thank you!
Ludo’.
[Message part 2 (text/x-patch, inline)]
diff --git a/doc/guix.texi b/doc/guix.texi
index 3d764e6021..a796d9c8f8 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -44265,18 +44265,12 @@ Essential Home Services
be:
@lisp
-(use-modules (guix utils))
-
(home-environment
-
- [...]
-
+ ;; @dots{}
(services
(service home-dotfiles-service-type
(home-dotfiles-configuration
- (directories
- (list (string-append (current-source-directory)
- "/.dotfiles")))))))
+ (directories (list "./dot-files"))))))
@end lisp
The expected home directory state would be:
diff --git a/gnu/home/services.scm b/gnu/home/services.scm
index 3e925c07c8..c7379c93c7 100644
--- a/gnu/home/services.scm
+++ b/gnu/home/services.scm
@@ -1,7 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2021-2023 Andrew Tropin <andrew <at> trop.in>
;;; Copyright © 2021 Xinglu Chen <public <at> yoctocell.xyz>
-;;; Copyright © 2022-2023 Ludovic Courtès <ludo <at> gnu.org>
+;;; Copyright © 2022-2024 Ludovic Courtès <ludo <at> gnu.org>
;;; Copyright © 2023 Carlo Zancanaro <carlo <at> zancanaro.id.au>
;;; Copyright © 2023 Giacomo Leidi <goodoldpaul <at> autistici.org>
;;;
@@ -24,7 +24,7 @@ (define-module (gnu home services)
#:use-module (gnu services)
#:use-module ((gnu packages package-management) #:select (guix))
#:use-module ((gnu packages base) #:select (coreutils))
- #:use-module (guix build utils)
+ #:autoload (guix build utils) (find-files)
#:use-module (guix channels)
#:use-module (guix monads)
#:use-module (guix store)
@@ -32,6 +32,7 @@ (define-module (gnu home services)
#:use-module (guix profiles)
#:use-module (guix sets)
#:use-module (guix ui)
+ #:use-module ((guix utils) #:select (current-source-directory))
#:use-module (guix discovery)
#:use-module (guix diagnostics)
#:use-module (guix i18n)
@@ -43,7 +44,6 @@ (define-module (gnu home services)
#:use-module (ice-9 ftw)
#:use-module (ice-9 match)
#:use-module (ice-9 regex)
- #:use-module (ice-9 string-fun)
#:use-module (ice-9 vlist)
#:export (home-service-type
@@ -375,65 +375,69 @@ (define %home-dotfiles-excluded
(define-record-type* <home-dotfiles-configuration>
home-dotfiles-configuration make-home-dotfiles-configuration
home-dotfiles-configuration?
+ (source-directory home-dotfiles-configuration-source-directory
+ (default (current-source-directory))
+ (innate))
(directories home-dotfiles-configuration-directories ;list of strings
(default '()))
(excluded home-dotfiles-configuration-excluded ;list of strings
(default %home-dotfiles-excluded)))
-(define* (import-dotfiles directory excluded)
+(define (import-dotfiles directory files)
"Return a list of objects compatible with @code{home-files-service-type}'s
value. Each object is a pair where the first element is the relative path
of a file and the second is a gexp representing the file content. Objects are
generated by recursively visiting DIRECTORY and mapping its contents to the
user's home directory, excluding files that match any of the patterns in EXCLUDED."
- (define filtered
- (find-files directory
- (lambda (file stat)
- (not (string-match
- (string-append
- "^.*(" (string-join excluded "|") ")$") file)))))
(define (strip file)
- (string-drop file (+ 1 (string-length directory))))
- (define (resolve file)
- (if (eq? 'symlink (stat:type (lstat file)))
- (let ((resolved (readlink file)))
- (with-directory-excursion (dirname file)
- (canonicalize-path resolved)))
- file))
+ (string-drop file (+ 1 (string-length directory))))
+
(define (format file)
- (let* ((without-spaces
- (string-replace-substring file " " "_"))
- (without-slashes-and-spaces
- (string-replace-substring without-spaces "/" "-")))
- (string-append "home-dotfiles-" without-slashes-and-spaces)))
+ ;; Remove from FILE characters that cannot be used in the store.
+ (string-append
+ "home-dotfiles-"
+ (string-map (lambda (chr)
+ (if (and (char-set-contains? char-set:ascii chr)
+ (char-set-contains? char-set:graphic chr)
+ (not (memv chr '(#\. #\/))))
+ chr
+ #\-))
+ file)))
(map (lambda (file)
- (let* ((stripped (strip file)))
+ (let ((stripped (strip file)))
(list stripped
- (local-file (resolve file) (format stripped)
+ (local-file file (format stripped)
#:recursive? #t))))
- filtered))
+ files))
(define (home-dotfiles-configuration->files config)
- "Return a list of objects compatible with @code{home-files-service-type}'s
+ "Return a list of objects compatible with @code{home-files-service-type}'s
value, generated following GNU Stow's algorithm for each of the
directories in CONFIG, excluding files that match any of the patterns configured."
- (define (directory-contents directories)
- (append-map
- (lambda (directory)
- (map
- (lambda (content)
- (with-directory-excursion directory
- (canonicalize-path content)))
- (scandir directory
- (lambda (name)
- (not (member name '("." "..")))))))
- directories))
- (append-map
- (lambda (app)
- (import-dotfiles app (home-dotfiles-configuration-excluded config)))
- (directory-contents
- (home-dotfiles-configuration-directories config))))
+ (define excluded
+ (home-dotfiles-configuration-excluded config))
+ (define exclusion-rx
+ (make-regexp (string-append "^.*(" (string-join excluded "|") ")$")))
+
+ (define (directory-contents directory)
+ (find-files directory
+ (lambda (file stat)
+ (not (regexp-exec exclusion-rx
+ (basename file))))))
+
+ (define (resolve directory)
+ ;; Resolve DIRECTORY relative to the 'source-directory' field of CONFIG.
+ (if (string-prefix? "/" directory)
+ directory
+ (in-vicinity (home-dotfiles-configuration-source-directory config)
+ directory)))
+
+ (append-map (lambda (directory)
+ (let* ((directory (resolve directory))
+ (contents (directory-contents directory)))
+ (import-dotfiles directory contents)))
+ (home-dotfiles-configuration-directories config)))
(define-public home-dotfiles-service-type
(service-type (name 'home-dotfiles)
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.