From patchwork Sat Jan 27 22:56:29 2024 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: =?utf-8?q?Ludovic_Court=C3=A8s?= X-Patchwork-Id: 59492 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id A871127BBEA; Sat, 27 Jan 2024 22:57:31 +0000 (GMT) X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-3.7 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,MAILING_LIST_MULTI,RCVD_IN_MSPIKE_H5,RCVD_IN_MSPIKE_WL, SPF_HELO_PASS,URIBL_BLOCKED autolearn=ham autolearn_force=no version=3.4.6 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id 9979B27BBE2 for ; Sat, 27 Jan 2024 22:57:27 +0000 (GMT) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1rTrbm-0004rR-MX; Sat, 27 Jan 2024 17:57:06 -0500 Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1rTrbk-0004rE-Jg for guix-patches@gnu.org; Sat, 27 Jan 2024 17:57:04 -0500 Received: from debbugs.gnu.org ([2001:470:142:5::43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1rTrbb-0007fE-M3 for guix-patches@gnu.org; Sat, 27 Jan 2024 17:57:04 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1rTrbi-0008VS-IF for guix-patches@gnu.org; Sat, 27 Jan 2024 17:57:02 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#60521] [PATCH v6] home: Add home-dotfiles-service. Resent-From: Ludovic =?utf-8?q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Sat, 27 Jan 2024 22:57:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 60521 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: moreinfo patch To: Giacomo Leidi Cc: 60521@debbugs.gnu.org Received: via spool by 60521-submit@debbugs.gnu.org id=B60521.170639621132672 (code B ref 60521); Sat, 27 Jan 2024 22:57:02 +0000 Received: (at 60521) by debbugs.gnu.org; 27 Jan 2024 22:56:51 +0000 Received: from localhost ([127.0.0.1]:56104 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1rTrbW-0008Uu-KF for submit@debbugs.gnu.org; Sat, 27 Jan 2024 17:56:51 -0500 Received: from eggs.gnu.org ([2001:470:142:3::10]:55036) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1rTrbS-0008Ud-D3 for 60521@debbugs.gnu.org; Sat, 27 Jan 2024 17:56:49 -0500 Received: from fencepost.gnu.org ([2001:470:142:3::e]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1rTrbE-0007d0-JB; Sat, 27 Jan 2024 17:56:32 -0500 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=gnu.org; s=fencepost-gnu-org; h=MIME-Version:Date:References:In-Reply-To:Subject:To: From; bh=A82hvVvcDyeZchOQHjvdveHMAe+ko0dgZlUWe7sMIdU=; b=E3C2/miZdMZKMcp5h153 lwAiMO8GUMO0fVwtPcUSxBf577OkEXxGwdittVZQXvlWW2Em1ohecHq/BqrkSGQqVZf6gLmc6iB+3 J/Gbt6wqkosxAZNui5W0DYfTGmcHLtHhyh/hqVj/tlkqo9WSYhqR8q2ztwTvMyaCv0qRCmg5sMIoT QfW8wrYe9T+03/F6iDAHTdaf7WRTiLBCLVuXkhwZ64ESS3XUNcUrc0fT3imVKFV66prZHH2BAp3mE aHzSrV/syGP3F7UHpKapPuZEVFzldaw797Pp5dmIxj3eLF94lKSspIdrWiKs4d7g+iFNjeYkVaYz/ 7ht/VdukmfmE+A==; From: Ludovic =?utf-8?q?Court=C3=A8s?= In-Reply-To: <20240126174850.9671-1-goodoldpaul@autistici.org> (Giacomo Leidi's message of "Fri, 26 Jan 2024 18:48:41 +0100") References: <0a8d7bce31856292baa06a08260494c0@autistici.org> <20240126174850.9671-1-goodoldpaul@autistici.org> Date: Sat, 27 Jan 2024 23:56:29 +0100 Message-ID: <874jeyjsgy.fsf@gnu.org> User-Agent: Gnus/5.13 (Gnus v5.13) MIME-Version: 1.0 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org X-getmail-retrieved-from-mailbox: Patches Hi Giacomo, Giacomo Leidi skribis: > * gnu/home/services.scm (dotfiles-for-app): New variable; > (home-dotfiles-configuration): new variable; > (home-dotfiles-service-type): new variable. > * doc/guix.texi: Document it. Apologies again for the long delay. The patch looks great to me and I think the functionality is there. I gave it a try for my own config, and that has led me to make the attached changes, which can be summarized as follows: • The dotfile directories are resolved relative the source location where ‘home-dotfiles-configuration’ appears. The advantage is that users do not need to fiddle with (current-source-directory). • As a consequence, all ‘with-directory-excursion’ and ‘canonicalize-path’ calls are gone. (Those should only be used with great care.) • The dotfile directories are traversed only once, using ‘find-files’. • The exclusion regexp is compiled only once (with ‘make-regexp’) and then reused (with ‘regexp-exec’ calls), which is more efficient than repeated ‘string-match’ calls. • Use ‘string-map’ instead of ‘string-replace-substring’ (it’s simpler and more efficient). If that’s fine with you, please feel free to apply these changes. One last thing I should have suggested earlier: how about moving it to (gnu home services dotfiles)? That would keep the scope of (gnu home services) limited to essential services. Please send one last version when you’re ready; I’m eager to use it for my own config actually. :-) Thank you! Ludo’. diff --git a/doc/guix.texi b/doc/guix.texi index 3d764e6021..a796d9c8f8 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -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: diff --git a/gnu/home/services.scm b/gnu/home/services.scm index 3e925c07c8..c7379c93c7 100644 --- a/gnu/home/services.scm +++ b/gnu/home/services.scm @@ -1,7 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2021-2023 Andrew Tropin ;;; Copyright © 2021 Xinglu Chen -;;; Copyright © 2022-2023 Ludovic Courtès +;;; Copyright © 2022-2024 Ludovic Courtès ;;; Copyright © 2023 Carlo Zancanaro ;;; Copyright © 2023 Giacomo Leidi ;;; @@ -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 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)