@@ -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:
@@ -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)