From 01f685d56016ae529381a73daedccc1949b808ec Mon Sep 17 00:00:00 2001 From: Giacomo Leidi Date: Wed, 6 Mar 2024 21:52:42 +0100 Subject: gnu: home: dotfiles: Properly support both plain and Stow directory layouts. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Fixes . The current implementation of the home-dotfiles-service-type contradicts the Guix manual. This patch properly implements both the plain and Stow dotfiles directory layouts. It does so by refactoring home-dotfiles-configuration adding a new packages field to support GNU Stow's users workflow and introducing a new layout field to switch between the two directory layouts. * gnu/home/services/dotfiles (home-dotfiles-configuration): Migrate to (gnu services configuration); [packages]: new field; [layout]: new field; (strip-stow-dotfile): new variable; (strip-plain-dotfile): new variable; (home-dotfiles-configuration->files): use the new fields; [directory-contents]: allow for selecting a subset of application dotfile directories; * doc/guix.texi: document the new layouts. Change-Id: I2e96037608353e360828290f055ec5271cfdfd48 Signed-off-by: Ludovic Courtès --- gnu/home/services/dotfiles.scm | 115 +++++++++++++++++++++++++++++++---------- 1 file changed, 88 insertions(+), 27 deletions(-) (limited to 'gnu/home') diff --git a/gnu/home/services/dotfiles.scm b/gnu/home/services/dotfiles.scm index 6a740c42ce..823bdb03fb 100644 --- a/gnu/home/services/dotfiles.scm +++ b/gnu/home/services/dotfiles.scm @@ -20,17 +20,25 @@ (define-module (gnu home services dotfiles) #:use-module (gnu home services) #:use-module (gnu services) + #:use-module (gnu services configuration) #:autoload (guix build utils) (find-files) + #:use-module (guix diagnostics) #:use-module (guix gexp) - #:use-module (guix records) + #:use-module (guix i18n) #:use-module ((guix utils) #:select (current-source-directory)) #: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-configuration home-dotfiles-configuration? + home-dotfiles-configuration-fields + home-dotfiles-configuration-layout home-dotfiles-configuration-source-directory + home-dotfiles-configuration-packages home-dotfiles-configuration-directories home-dotfiles-configuration-excluded)) @@ -40,26 +48,64 @@ "\\.git" "\\.gitignore")) -(define-record-type* - 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 files) +(define %home-dotfiles-layouts + '(plain stow)) + +(define (sanitize-layout value) + (if (member value %home-dotfiles-layouts) + value + (raise + (formatted-message + (G_ "layout field of home-dotfiles-configuration should be either 'plain +or 'stow, but ~a was found.") + value)))) + +(define list-of-strings? + (list-of string?)) + +(define-maybe list-of-strings) + +(define-configuration/no-serialization home-dotfiles-configuration + (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-configuration} appears.") + (layout + (symbol 'plain) + "The intended layout of the specified @code{directory}. It can be either +@code{'stow} or @code{'plain}." + (sanitizer sanitize-layout)) + (directories + (list-of-strings '()) + "The list of dotfiles directories 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. This field will be ignored if @code{layout} is set +to @code{'plain}.") + (excluded + (list-of-strings %home-dotfiles-excluded) + "The list of file patterns @code{home-dotfiles-service-type} will exclude +while visiting @code{directory}.")) + +(define (strip-stow-dotfile file-name directory) + (let ((dotfile-name (string-drop file-name (1+ (string-length directory))))) + (match (string-split dotfile-name #\/) + ((package parts ...) + (string-join parts "/"))))) + +(define (strip-plain-dotfile file-name directory) + (string-drop file-name (+ 1 (string-length directory)))) + +(define (import-dotfiles directory files strip) "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 (strip file) - (string-drop file (+ 1 (string-length directory)))) - (define (format file) ;; Remove from FILE characters that cannot be used in the store. (string-append @@ -73,7 +119,7 @@ user's home directory, excluding files that match any of the patterns in EXCLUDE file))) (map (lambda (file) - (let ((stripped (strip file))) + (let ((stripped (strip file directory))) (list stripped (local-file file (format stripped) #:recursive? #t)))) @@ -81,18 +127,25 @@ user's home directory, excluding files that match any of the patterns in EXCLUDE (define (home-dotfiles-configuration->files config) "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." +value, excluding files that match any of the patterns configured." + (define stow? (eq? (home-dotfiles-configuration-layout config) 'stow)) (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* (directory-contents directory #:key (packages #f)) + (define (filter-files directory) + (find-files directory + (lambda (file stat) + (not (regexp-exec exclusion-rx + (basename 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. @@ -103,15 +156,23 @@ directories in CONFIG, excluding files that match any of the patterns configured (append-map (lambda (directory) (let* ((directory (resolve directory)) - (contents (directory-contents directory))) - (import-dotfiles directory contents))) + (packages + (home-dotfiles-configuration-packages config)) + (contents + (directory-contents directory + #:packages packages)) + (strip + (if stow? strip-stow-dotfile strip-plain-dotfile))) + (import-dotfiles directory contents strip))) (home-dotfiles-configuration-directories config))) (define-public home-dotfiles-service-type (service-type (name 'home-dotfiles) (extensions (list (service-extension home-files-service-type - home-dotfiles-configuration->files))) + (lambda (config) + (when config + (home-dotfiles-configuration->files config)))))) (default-value (home-dotfiles-configuration)) (description "Files that will be put in the user's home directory following GNU Stow's algorithm, and further processed during activation."))) -- cgit v1.2.3