summaryrefslogtreecommitdiff
path: root/gnu/home
diff options
context:
space:
mode:
authorGiacomo Leidi <goodoldpaul@autistici.org>2024-01-28 16:37:16 +0100
committerLudovic Courtès <ludo@gnu.org>2024-01-28 22:50:49 +0100
commit2f67528edd2d7669b441f61cb36d1b0f4f60bdb9 (patch)
tree02ea87f864fc5cd89dd7598088f2ed43108ae3e2 /gnu/home
parent68b2a19c20170ace0a2cdf7f93cff747638d3516 (diff)
home: Add home-dotfiles-service.
* gnu/home/service/dotfiles.scm: New file; * gnu/local.mk (GNU_SYSTEM_MODULES): Add it. * po/guix/POTFILES.in: Add it. * doc/guix.texi (Essential Home Services): Document it. Change-Id: I6769169cfacefc3842faa5b31bee081c56c28743 Co-authored-by: Ludovic Courtès <ludo@gnu.org>
Diffstat (limited to 'gnu/home')
-rw-r--r--gnu/home/services/dotfiles.scm117
1 files changed, 117 insertions, 0 deletions
diff --git a/gnu/home/services/dotfiles.scm b/gnu/home/services/dotfiles.scm
new file mode 100644
index 0000000000..6a740c42ce
--- /dev/null
+++ b/gnu/home/services/dotfiles.scm
@@ -0,0 +1,117 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2024 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2024 Giacomo Leidi <goodoldpaul@autistici.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu home services dotfiles)
+ #:use-module (gnu home services)
+ #:use-module (gnu services)
+ #:autoload (guix build utils) (find-files)
+ #:use-module (guix gexp)
+ #:use-module (guix records)
+ #:use-module ((guix utils) #:select (current-source-directory))
+ #:use-module (srfi srfi-1)
+ #:use-module (ice-9 ftw)
+ #:use-module (ice-9 regex)
+ #:export (home-dotfiles-service-type
+ home-dotfiles-configuration
+ home-dotfiles-configuration?
+ home-dotfiles-configuration-source-directory
+ home-dotfiles-configuration-directories
+ home-dotfiles-configuration-excluded))
+
+(define %home-dotfiles-excluded
+ '(".*~"
+ ".*\\.swp"
+ "\\.git"
+ "\\.gitignore"))
+
+(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 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 (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
+ "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 '(#\. #\/ #\space))))
+ chr
+ #\-))
+ file)))
+
+ (map (lambda (file)
+ (let ((stripped (strip file)))
+ (list stripped
+ (local-file file (format stripped)
+ #:recursive? #t))))
+ files))
+
+(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."
+ (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)
+ (extensions
+ (list (service-extension home-files-service-type
+ home-dotfiles-configuration->files)))
+ (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.")))