From 2f67528edd2d7669b441f61cb36d1b0f4f60bdb9 Mon Sep 17 00:00:00 2001 From: Giacomo Leidi Date: Sun, 28 Jan 2024 16:37:16 +0100 Subject: home: Add home-dotfiles-service. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * 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 --- gnu/home/services/dotfiles.scm | 117 +++++++++++++++++++++++++++++++++++++++++ 1 file changed, 117 insertions(+) create mode 100644 gnu/home/services/dotfiles.scm (limited to 'gnu/home') 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 +;;; Copyright © 2024 Giacomo Leidi +;;; +;;; 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 . + +(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 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."))) -- cgit v1.2.3