[bug#60521] [PATCH v6] home: Add home-dotfiles-service.

["Ludovic Courtès" <ludo@gnu.org>]

[-- Attachment #1: Type: text/plain, Size: 1663 bytes --]

Hi Giacomo,

Giacomo Leidi <goodoldpaul@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’.


[-- Attachment #2: Type: text/x-patch, Size: 7016 bytes --]

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@trop.in>
 ;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
-;;; Copyright © 2022-2023 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2022-2024 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2023 Carlo Zancanaro <carlo@zancanaro.id.au>
 ;;; Copyright © 2023 Giacomo Leidi <goodoldpaul@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)