[bug#74629] [PATCH] gnu: home: dotfiles: Update configuration record.

[Giacomo Leidi via Guix-patches via <guix-patches@gnu.org>]

This patch implements home-dotfiles-environment, a new configuration
record for the home-dotfiles-service-type.  The new record has slightly
different semantics allowing to fix a bug where some directories where
mistakenly included while also being present in the excluded field. It
also separates better the state required for Stow layouts, from the one
needed by plain layouts. The home-dotfiles-configuration record and
related procedures are marked as deprecated according to the deprecation
policy.

* gnu/home/services/dotfiles.scm (plain-dotfiles-directory): New
variable;
(stow-dotfiles-directory): new variable;
(home-dotfiles-environment): new variable;
(home-dotfiles-configuration): deprecate in favor of
home-dotfiles-environment;
(home-dotfiles-directory->files/internal): new procedure;
(home-dotfiles-directory->files): deprecate procedure in favor of
home-dotfiles-environment->files;
(home-dotfiles-environment->files): new procedure;
(home-dotfiles-service-files): new procedure;
(home-dotfiles-service-type): change default value to
home-dotfiles-environment.
* doc/guix.texi: Document it.

Fixes <https://issues.guix.gnu.org/71217>

Change-Id: I6dec073354b2d3145f1dd508d1037f9fc4cd2635
---
 doc/guix.texi                  |  72 +++++++++++++--
 gnu/home/services/dotfiles.scm | 154 +++++++++++++++++++++++++++++----
 2 files changed, 203 insertions(+), 23 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 26488b41c8..cf8be82633 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -45681,7 +45681,7 @@ Essential Home Services
 Guix Home configuration.
 
 There are two supported dotfiles directory layouts, for now. The
-@code{'plain} layout, which is structured as follows:
+@code{plain-dotfiles-directory} layout is structured as follows:
 
 @example
 ~$ tree -a ./dotfiles/
@@ -45704,7 +45704,7 @@ Essential Home Services
 This tree structure is installed as is to the
 home directory upon @command{guix home reconfigure}.
 
-The @code{'stow} layout, which must
+The @code{stow-dotfiles-directory} layout must
 follow the layout suggested by
 @uref{https://www.gnu.org/software/stow/, GNU Stow} presents an additional
 application specific directory layer, just like:
@@ -45741,15 +45741,18 @@ Essential Home Services
 (@pxref{Top,,, stow, Introduction}). This tree structure is installed following
 GNU Stow's logic to the home directory upon @command{guix home reconfigure}.
 
-A suitable configuration with a @code{'plain} layout could be:
+A suitable configuration with a @code{plain-dotfiles-directory} layout could be:
 
 @lisp
 (home-environment
   ;; @dots{}
   (services
     (service home-dotfiles-service-type
-             (home-dotfiles-configuration
-               (directories '("./dotfiles"))))))
+             (home-dotfiles-environment
+               (directories
+                 (list
+                   (plain-dotfiles-directory
+                     (name "./dotfiles"))))))))
 @end lisp
 
 The expected home directory state would then be:
@@ -45783,8 +45786,65 @@ Essential Home Services
 
 @c %start of fragment
 
+@deftp {Data Type} home-dotfiles-environment
+Available @code{home-dotfiles-environment} fields are:
+
+@table @asis
+@item @code{source-directory} (default: @code{(current-source-directory)}) (type: string)
+The path where dotfile directories are resolved.  By default dotfile
+directories are resolved relative the source location where
+@code{home-dotfiles-environment} appears.
+
+@item @code{directories} (default: @code{'()}) (type: list-of-dotfiles-directories)
+The list of dotfiles directories where @code{home-dotfiles-service-type}
+will look for application dotfiles.
+
+@item @code{excluded} (default: @code{'(".*~" ".*\\.swp" "\\.git/.*" "\\.gitignore")}) (type: list-of-strings)
+The list of file or directory patterns @code{home-dotfiles-service-type} will exclude
+while visiting each one of the @code{directories}.
+
+@end table
+
+@end deftp
+
+@deftp {Data Type} plain-dotfiles-directory
+Available @code{plain-dotfiles-directory} fields are:
+
+@table @asis
+@item @code{name} (type: string)
+The path of the dotfiles directory where @code{home-dotfiles-service-type}
+will look for application dotfiles.
+
+@end table
+
+@end deftp
+
+@deftp {Data Type} stow-dotfiles-directory
+Available @code{stow-dotfiles-directory} fields are:
+
+@table @asis
+@item @code{name} (type: string)
+The path of the dotfiles directory where @code{home-dotfiles-service-type}
+will look for application dotfiles.
+
+@item @code{packages} (type: maybe-list-of-strings)
+The names of a subset of the GNU Stow package layer directories.  When provided
+the @code{home-dotfiles-service-type} will only provision dotfiles from this
+subset of applications.
+
+@end table
+
+@end deftp
+
+@c %end of fragment
+
+@c %start of fragment
+
 @deftp {Data Type} home-dotfiles-configuration
-Available @code{home-dotfiles-configuration} fields are:
+The @code{home-dotfiles-configuration} is the legacy configuration record for the
+@code{home-dotfiles-service-type}, it is now deprecated in favor of
+@code{home-dotfiles-environment}, @code{stow-dotfiles-directory} and
+@code{plain-dotfiles-directory}.  Its fields are:
 
 @table @asis
 @item @code{source-directory} (default: @code{(current-source-directory)}) (type: string)
diff --git a/gnu/home/services/dotfiles.scm b/gnu/home/services/dotfiles.scm
index 823bdb03fb..e4a296588e 100644
--- a/gnu/home/services/dotfiles.scm
+++ b/gnu/home/services/dotfiles.scm
@@ -22,16 +22,18 @@ (define-module (gnu home services dotfiles)
   #:use-module (gnu services)
   #:use-module (gnu services configuration)
   #:autoload   (guix build utils) (find-files)
+  #:use-module (guix deprecation)
   #:use-module (guix diagnostics)
   #:use-module (guix gexp)
   #:use-module (guix i18n)
-  #:use-module ((guix utils) #:select (current-source-directory))
+  #:use-module ((guix utils) #:select (current-source-directory source-properties->location))
   #:use-module (srfi srfi-1)
   #:use-module (ice-9 ftw)
   #:use-module (ice-9 match)
   #:use-module (ice-9 regex)
   #:export (home-dotfiles-service-type
             home-dotfiles-configuration->files
+            home-dotfiles-environment->files
 
             home-dotfiles-configuration
             home-dotfiles-configuration?
@@ -40,24 +42,39 @@ (define-module (gnu home services dotfiles)
             home-dotfiles-configuration-source-directory
             home-dotfiles-configuration-packages
             home-dotfiles-configuration-directories
-            home-dotfiles-configuration-excluded))
+            home-dotfiles-configuration-excluded
+
+            home-dotfiles-environment
+            home-dotfiles-environment?
+            home-dotfiles-environment-fields
+            home-dotfiles-environment-source-directory
+            home-dotfiles-environment-directories
+            home-dotfiles-environment-excluded
+
+            stow-dotfiles-directory
+            stow-dotfiles-directory?
+            stow-dotfiles-directory-fields
+            stow-dotfiles-directory-name
+            stow-dotfiles-directory-packages
+
+            plain-dotfiles-directory
+            plain-dotfiles-directory?
+            plain-dotfiles-directory-fields
+            plain-dotfiles-directory-name))
 
 (define %home-dotfiles-excluded
   '(".*~"
     ".*\\.swp"
-    "\\.git"
+    "\\.git/.*"
     "\\.gitignore"))
 
-(define %home-dotfiles-layouts
-  '(plain stow))
-
 (define (sanitize-layout value)
-  (if (member value %home-dotfiles-layouts)
+  (if (member value '(plain stow))
       value
       (raise
        (formatted-message
-        (G_ "layout field of home-dotfiles-configuration should be either 'plain
-or 'stow, but ~a was found.")
+        (G_ "layout field of home-dotfiles-configuration should be either
+'plain or 'stow, but ~a was found.")
         value))))
 
 (define list-of-strings?
@@ -87,10 +104,55 @@ (define-configuration/no-serialization home-dotfiles-configuration
 subset of applications.  This field will be ignored if @code{layout} is set
 to @code{'plain}.")
   (excluded
-   (list-of-strings %home-dotfiles-excluded)
+   (list-of-strings '(".*~" ".*\\.swp" "\\.git" "\\.gitignore"))
    "The list of file patterns @code{home-dotfiles-service-type} will exclude
 while visiting @code{directory}."))
 
+(define-configuration/no-serialization plain-dotfiles-directory
+  (name
+   (string)
+   "The path of the dotfiles directory where @code{home-dotfiles-service-type}
+will look for application dotfiles."))
+
+(define-configuration/no-serialization stow-dotfiles-directory
+  (name
+   (string)
+   "The path of the dotfiles directory where @code{home-dotfiles-service-type}
+will look for application dotfiles.")
+  (packages
+   (maybe-list-of-strings)
+   "The names of a subset of the GNU Stow package layer directories.  When provided
+the @code{home-dotfiles-service-type} will only provision dotfiles from this
+subset of applications."))
+
+(define (list-of-dotfiles-directories? value)
+  (map
+   (lambda (record)
+     (if (or (plain-dotfiles-directory? record)
+             (stow-dotfiles-directory? record))
+         value
+         (raise
+          (formatted-message
+           (G_ "directories field of home-dotfiles-environment should be either a
+plain-dotfiles-directory or stow-dotfiles-directory record, but ~a was found.")
+           record))))
+   value))
+
+(define-configuration/no-serialization home-dotfiles-environment
+  (source-directory
+   (string (current-source-directory))
+   "The path where dotfile directories are resolved.  By default dotfile
+directories are resolved relative the source location where
+@code{home-dotfiles-environment} appears.")
+  (directories
+   (list-of-dotfiles-directories '())
+   "The list of dotfiles directories where @code{home-dotfiles-service-type}
+will look for application dotfiles.")
+  (excluded
+   (list-of-strings %home-dotfiles-excluded)
+   "The list of file patterns @code{home-dotfiles-service-type} will exclude
+while visiting each one of the @code{directories}."))
+
 (define (strip-stow-dotfile file-name directory)
   (let ((dotfile-name (string-drop file-name (1+ (string-length directory)))))
     (match (string-split dotfile-name #\/)
@@ -125,9 +187,14 @@ (define (import-dotfiles directory files strip)
                              #:recursive? #t))))
        files))
 
-(define (home-dotfiles-configuration->files config)
-  "Return a list of objects compatible with @code{home-files-service-type}'s
-value, excluding files that match any of the patterns configured."
+;; This procedure exists only to avoid the deprecation
+;; warning when compiling home-dotfiles-service-files.
+;; Once the deprecation period is over this internal procedure
+;; can be removed, together with home-dotfiles-service-files
+;; and home-dotfiles-configuration->files.
+(define (home-dotfiles-configuration->files/internal config)
+  (warning (G_ "'~a' is deprecated, use '~a' instead~%")
+           'home-dotfiles-configuration 'home-dotfiles-environment)
   (define stow? (eq? (home-dotfiles-configuration-layout config) 'stow))
   (define excluded
     (home-dotfiles-configuration-excluded config))
@@ -166,13 +233,66 @@ (define (home-dotfiles-configuration->files config)
                   (import-dotfiles directory contents strip)))
               (home-dotfiles-configuration-directories config)))
 
+(define-deprecated (home-dotfiles-configuration->files config)
+  home-dotfiles-environment->files
+  (home-dotfiles-configuration->files/internal config))
+
+(define (home-dotfiles-environment->files config)
+  "Return a list of objects compatible with @code{home-files-service-type}'s
+value, excluding files that match any of the patterns configured."
+  (define excluded
+    (home-dotfiles-environment-excluded config))
+  (define exclusion-rx
+    (make-regexp (string-append "^.*(" (string-join excluded "|") ")$")))
+
+  (define* (directory-contents directory #:key (stow? #f) (packages #f))
+    (define (filter-files directory)
+      (find-files directory
+                  (lambda (file stat)
+                    (not (regexp-exec exclusion-rx file)))))
+    (if (and stow? packages (maybe-value-set? packages))
+        (append-map filter-files
+                    (map (lambda (pkg)
+                           (string-append directory "/" pkg))
+                         packages))
+        (filter-files directory)))
+
+  (define (resolve directory)
+    ;; Resolve DIRECTORY relative to the 'source-directory' field of CONFIG.
+    (if (string-prefix? "/" directory)
+        directory
+        (in-vicinity (home-dotfiles-environment-source-directory config)
+                     directory)))
+
+  (append-map (lambda (record)
+                (let* ((stow? (stow-dotfiles-directory? record))
+                       (name
+                        (if stow?
+                            (stow-dotfiles-directory-name record)
+                            (plain-dotfiles-directory-name record)))
+                       (directory (resolve name))
+                       (packages
+                        (and stow?
+                             (stow-dotfiles-directory-packages record)))
+                       (contents
+                        (directory-contents directory
+                                            #:stow? stow?
+                                            #:packages packages))
+                       (strip
+                        (if stow? strip-stow-dotfile strip-plain-dotfile)))
+                  (import-dotfiles directory contents strip)))
+              (home-dotfiles-environment-directories config)))
+
+(define (home-dotfiles-service-files config)
+  (if (home-dotfiles-environment? config)
+      (home-dotfiles-environment->files config)
+      (home-dotfiles-configuration->files/internal config)))
+
 (define-public home-dotfiles-service-type
   (service-type (name 'home-dotfiles)
                 (extensions
                  (list (service-extension home-files-service-type
-                                          (lambda (config)
-                                            (when config
-                                              (home-dotfiles-configuration->files config))))))
-                (default-value (home-dotfiles-configuration))
+                                          home-dotfiles-service-files)))
+                (default-value (home-dotfiles-environment))
                 (description "Files that will be put in the user's home directory
 following GNU Stow's algorithm, and further processed during activation.")))

base-commit: 9b1fb12978482ffb6d37c456343f05609b28b3e8
-- 
2.46.0