From debbugs-submit-bounces@debbugs.gnu.org Mon Oct 04 19:14:08 2021 Received: (at 50967) by debbugs.gnu.org; 4 Oct 2021 23:14:08 +0000 Received: from localhost ([127.0.0.1]:38593 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1mXX9o-0006cJ-GW for submit@debbugs.gnu.org; Mon, 04 Oct 2021 19:14:08 -0400 Received: from mail-lf1-f43.google.com ([209.85.167.43]:38652) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1mXX9j-0006bQ-Pw for 50967@debbugs.gnu.org; Mon, 04 Oct 2021 19:14:03 -0400 Received: by mail-lf1-f43.google.com with SMTP id x27so78306382lfu.5 for <50967@debbugs.gnu.org>; Mon, 04 Oct 2021 16:13:59 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20210112; h=from:to:cc:subject:date:message-id:in-reply-to:references :mime-version:content-transfer-encoding; bh=f60yKHn+X2EHT6kC0C8BhhkkXKiGuCHiR+X+q1VwQV8=; b=bi4YmzPbsXOjlW/Rk6Nx1LQc36hwLcp6LWSfitHc2tMF5ze2K8754y/jQ5urbacAWW 26LwgkRCuFzSspooF2Zv49ta4iD+0hxjeV3GxVN4vdnUlHrYFdjPwAQiY1+ZHcck9zcJ 0msMWcpmgeMlUo2NnuWPTvaOs0bFnMv8BXsn5qIXwD5mg4gWBAN4lWcZdTeDRdSqEuSG rdHFiG4/FTG/Y3+Xp8y1KrvO/QXflb7c9UXuy6PSL7AqGZEjmWQyXFQ3sH+8iTvaHqnW l8fRGeXvY8w1yPGho1mAPBb8RXV6XI8kv6zy6Z/G85cP+AmnCMXtCfEElgVrEW+T45F7 nVxg== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20210112; h=x-gm-message-state:from:to:cc:subject:date:message-id:in-reply-to :references:mime-version:content-transfer-encoding; bh=f60yKHn+X2EHT6kC0C8BhhkkXKiGuCHiR+X+q1VwQV8=; b=mihQAbC3IKB3rnxrj4di0vqqZxI9FtbLJOCav4KCivi5YdGCCr+24njgl5s1fg5+Fp mnYZ4DBEpMyV3UbiNilIpSAk44V+0hKF2NXFBIwcMELwQSoLdAB5C+doeTq3N3PrNnet l0g/iHEqDRZIovKzZh/6sPIxxQWgzDWD/zU1yhb6CUNJpeN4/NPpDUI2bqNYhm+mXCFH deNxtOeE2KbkAqfIeY+h5600Di253PXm9YDvvkriYS5gxPqCLQvsfo45NsGP8BvJxNBv tLWo82LqtMq+iwwtfSyD7zVnvT7mAXg6Faq1c5aSVCBTwiCfkRAHL99TbwpyPpEKHL4K MyDQ== X-Gm-Message-State: AOAM5319w96oM4maENaCgc19wfsxj3zXWKkIp0XC+eRRZwSnbzjsn+Le MngOUwfmfdqf1Zt6QO8etNACpkDAXoU= X-Google-Smtp-Source: ABdhPJxQzDpK8MbVcFSPIRrxlVPXXWpbX4gF1Kk57GIjU/fDHsc09zbxvtpVcO2z2g9VJbSgKNvC6A== X-Received: by 2002:ac2:5ece:: with SMTP id d14mr17263622lfq.451.1633389233557; Mon, 04 Oct 2021 16:13:53 -0700 (PDT) Received: from localhost.localdomain ([88.201.161.72]) by smtp.gmail.com with ESMTPSA id h4sm1736542lft.184.2021.10.04.16.13.53 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Mon, 04 Oct 2021 16:13:53 -0700 (PDT) From: Oleg Pykhalov To: 50967@debbugs.gnu.org Subject: [PATCH 2/3] home: services: configuration: Support file-like objects. Date: Tue, 5 Oct 2021 02:13:30 +0300 Message-Id: <20211004231331.5269-2-go.wigust@gmail.com> X-Mailer: git-send-email 2.33.0 In-Reply-To: <20211004231331.5269-1-go.wigust@gmail.com> References: <87h7dwq4cb.fsf_-_@gnu.org> <20211004231331.5269-1-go.wigust@gmail.com> MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit X-Spam-Score: 2.0 (++) X-Spam-Report: Spam detection software, running on the system "debbugs.gnu.org", has NOT identified this incoming email as spam. The original message has been attached to this so you can view it or label similar future email. If you have any questions, see the administrator of that system for details. Content preview: * gnu/home/services/configuration.scm (interpose): Operate only with file-like objects. (string-or-gexp?): Delete procedure. (serialize-string-or-gexp): Rename to 'serialize-file-like'. (text-config?) [...] Content analysis details: (2.0 points, 10.0 required) pts rule name description ---- ---------------------- -------------------------------------------------- -0.0 SPF_PASS SPF: sender matches SPF record 0.0 FREEMAIL_FROM Sender email is commonly abused enduser mail provider (go.wigust[at]gmail.com) 2.0 PDS_OTHER_BAD_TLD Untrustworthy TLDs [URI: yoctocell.xyz (xyz)] 0.0 SPF_HELO_NONE SPF: HELO does not publish an SPF Record -0.0 RCVD_IN_MSPIKE_H2 RBL: Average reputation (+2) [209.85.167.43 listed in wl.mailspike.net] -0.0 RCVD_IN_DNSWL_NONE RBL: Sender listed at https://www.dnswl.org/, no trust [209.85.167.43 listed in list.dnswl.org] X-Debbugs-Envelope-To: 50967 Cc: Oleg Pykhalov , =?UTF-8?q?Ludovic=20Court=C3=A8s?= , Xinglu Chen , Andrew Tropin X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: 1.0 (+) * gnu/home/services/configuration.scm (interpose): Operate only with file-like objects. (string-or-gexp?): Delete procedure. (serialize-string-or-gexp): Rename to 'serialize-file-like'. (text-config?): Call 'file-like' intead of 'string-or-gexp?'. * guix/scripts/home/import.scm: (generate-bash-module+configuration): Don't call slurp-file-gexp. * gnu/home/services/configuration.scm: Move content ... * gnu/services/configuration.scm: here. * gnu/home/services/shells.scm: Delete (gnu home services configuration). * gnu/home/services/xdg.scm: Same. * gnu/local.mk: Same. --- gnu/home/services/configuration.scm | 109 ---------------------------- gnu/home/services/shells.scm | 1 - gnu/home/services/xdg.scm | 1 - gnu/local.mk | 1 - gnu/services/configuration.scm | 90 ++++++++++++++++++++++- guix/scripts/home/import.scm | 8 +- 6 files changed, 91 insertions(+), 119 deletions(-) delete mode 100644 gnu/home/services/configuration.scm diff --git a/gnu/home/services/configuration.scm b/gnu/home/services/configuration.scm deleted file mode 100644 index 5e7743e7d6..0000000000 --- a/gnu/home/services/configuration.scm +++ /dev/null @@ -1,109 +0,0 @@ -;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2021 Andrew Tropin -;;; Copyright © 2021 Xinglu Chen -;;; -;;; 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 configuration) - #:use-module (gnu services configuration) - #:use-module (guix gexp) - #:use-module (srfi srfi-1) - #:use-module (ice-9 curried-definitions) - #:use-module (ice-9 match) - #:use-module (guix i18n) - #:use-module (guix diagnostics) - - #:export (filter-configuration-fields - - interpose - list-of - - list-of-strings? - alist? - string-or-gexp? - serialize-string-or-gexp - text-config? - serialize-text-config - generic-serialize-alist-entry - generic-serialize-alist)) - -(define* (filter-configuration-fields configuration-fields fields - #:optional negate?) - "Retrieve the fields listed in FIELDS from CONFIGURATION-FIELDS. -If NEGATE? is @code{#t}, retrieve all fields except FIELDS." - (filter (lambda (field) - (let ((member? (member (configuration-field-name field) fields))) - (if (not negate?) member? (not member?)))) - configuration-fields)) - - -(define* (interpose ls #:optional (delimiter "\n") (grammar 'infix)) - "Same as @code{string-join}, but without join and string, returns an -DELIMITER interposed LS. Support 'infix and 'suffix GRAMMAR values." - (when (not (member grammar '(infix suffix))) - (raise - (formatted-message - (G_ "The GRAMMAR value must be 'infix or 'suffix, but ~a provided.") - grammar))) - (fold-right (lambda (e acc) - (cons e - (if (and (null? acc) (eq? grammar 'infix)) - acc - (cons delimiter acc)))) - '() ls)) - -(define (list-of pred?) - "Return a procedure that takes a list and check if all the elements of -the list result in @code{#t} when applying PRED? on them." - (lambda (x) - (if (list? x) - (every pred? x) - #f))) - - -(define list-of-strings? - (list-of string?)) - -(define alist? list?) - -(define (string-or-gexp? sg) (or (string? sg) (gexp? sg))) -(define (serialize-string-or-gexp field-name val) "") - -(define (text-config? config) - (and (list? config) (every string-or-gexp? config))) -(define (serialize-text-config field-name val) - #~(string-append #$@(interpose val "\n" 'suffix))) - -(define ((generic-serialize-alist-entry serialize-field) entry) - "Apply the SERIALIZE-FIELD procedure on the field and value of ENTRY." - (match entry - ((field . val) (serialize-field field val)))) - -(define (generic-serialize-alist combine serialize-field fields) - "Generate a configuration from an association list FIELDS. - -SERIALIZE-FIELD is a procedure that takes two arguments, it will be -applied on the fields and values of FIELDS using the -@code{generic-serialize-alist-entry} procedure. - -COMBINE is a procedure that takes one or more arguments and combines -all the alist entries into one value, @code{string-append} or -@code{append} are usually good candidates for this. - -See the @code{serialize-alist} procedure in `@code{(gnu home-services -version-control}' for an example usage.)}" - (apply combine - (map (generic-serialize-alist-entry serialize-field) fields))) diff --git a/gnu/home/services/shells.scm b/gnu/home/services/shells.scm index 2308371dd0..4e5825962c 100644 --- a/gnu/home/services/shells.scm +++ b/gnu/home/services/shells.scm @@ -19,7 +19,6 @@ (define-module (gnu home services shells) #:use-module (gnu services configuration) - #:use-module (gnu home services configuration) #:use-module (gnu home services utils) #:use-module (gnu home-services) #:use-module (gnu packages shells) diff --git a/gnu/home/services/xdg.scm b/gnu/home/services/xdg.scm index 4aed9a5803..c285d126dd 100644 --- a/gnu/home/services/xdg.scm +++ b/gnu/home/services/xdg.scm @@ -19,7 +19,6 @@ (define-module (gnu home services xdg) #:use-module (gnu services configuration) - #:use-module (gnu home services configuration) #:use-module (gnu home-services) #:use-module (gnu packages freedesktop) #:use-module (gnu home services utils) diff --git a/gnu/local.mk b/gnu/local.mk index 5e8b769ce9..9c3bf44a2b 100644 --- a/gnu/local.mk +++ b/gnu/local.mk @@ -77,7 +77,6 @@ GNU_SYSTEM_MODULES = \ %D%/home-services.scm \ %D%/home/services/symlink-manager.scm \ %D%/home/services/fontutils.scm \ - %D%/home/services/configuration.scm \ %D%/home/services/shells.scm \ %D%/home/services/shepherd.scm \ %D%/home/services/mcron.scm \ diff --git a/gnu/services/configuration.scm b/gnu/services/configuration.scm index df3d3b6f9b..60ab75b0c1 100644 --- a/gnu/services/configuration.scm +++ b/gnu/services/configuration.scm @@ -4,6 +4,7 @@ ;;; Copyright © 2017, 2018 Clément Lassieur ;;; Copyright © 2021 Xinglu Chen ;;; Copyright © 2021 Maxim Cournoyer +;;; Copyright © 2021 Andrew Tropin ;;; ;;; This file is part of GNU Guix. ;;; @@ -25,10 +26,12 @@ #:use-module (guix records) #:use-module (guix gexp) #:use-module ((guix utils) #:select (source-properties->location)) - #:use-module ((guix diagnostics) #:select (location-file)) + #:use-module ((guix diagnostics) #:select (formatted-message location-file)) #:use-module ((guix modules) #:select (file-name->module-name)) + #:use-module (guix i18n) #:autoload (texinfo) (texi-fragment->stexi) #:autoload (texinfo serialize) (stexi->texi) + #:use-module (ice-9 curried-definitions) #:use-module (ice-9 match) #:use-module (srfi srfi-1) #:use-module (srfi srfi-34) @@ -56,7 +59,20 @@ generate-documentation configuration->documentation empty-serializer - serialize-package)) + serialize-package + + filter-configuration-fields + + interpose + list-of + + list-of-strings? + alist? + serialize-file-like + text-config? + serialize-text-config + generic-serialize-alist-entry + generic-serialize-alist)) ;;; Commentary: ;;; @@ -323,3 +339,73 @@ Texinfo documentation of its fields." '-fields)))) (display (generate-documentation `((,configuration-symbol ,fields-getter)) configuration-symbol)))) + +(define* (filter-configuration-fields configuration-fields fields + #:optional negate?) + "Retrieve the fields listed in FIELDS from CONFIGURATION-FIELDS. +If NEGATE? is @code{#t}, retrieve all fields except FIELDS." + (filter (lambda (field) + (let ((member? (member (configuration-field-name field) fields))) + (if (not negate?) member? (not member?)))) + configuration-fields)) + + +(define* (interpose ls #:optional (delimiter "\n") (grammar 'infix)) + "Same as @code{string-join}, but without join and string, returns an +DELIMITER interposed LS. Support 'infix and 'suffix GRAMMAR values." + (when (not (member grammar '(infix suffix))) + (raise + (formatted-message + (G_ "The GRAMMAR value must be 'infix or 'suffix, but ~a provided.") + grammar))) + (fold-right (lambda (e acc) + (cons #~(begin + (use-modules (ice-9 rdelim)) + (with-fluids ((%default-port-encoding "UTF-8")) + (with-input-from-file #$e read-string))) + (if (and (null? acc) (eq? grammar 'infix)) + acc + (cons delimiter acc)))) + '() ls)) + +(define (list-of pred?) + "Return a procedure that takes a list and check if all the elements of +the list result in @code{#t} when applying PRED? on them." + (lambda (x) + (if (list? x) + (every pred? x) + #f))) + + +(define list-of-strings? + (list-of string?)) + +(define alist? list?) + +(define serialize-file-like empty-serializer) + +(define (text-config? config) + (list-of file-like?)) +(define (serialize-text-config field-name val) + #~(string-append #$@(interpose val "\n" 'suffix))) + +(define ((generic-serialize-alist-entry serialize-field) entry) + "Apply the SERIALIZE-FIELD procedure on the field and value of ENTRY." + (match entry + ((field . val) (serialize-field field val)))) + +(define (generic-serialize-alist combine serialize-field fields) + "Generate a configuration from an association list FIELDS. + +SERIALIZE-FIELD is a procedure that takes two arguments, it will be +applied on the fields and values of FIELDS using the +@code{generic-serialize-alist-entry} procedure. + +COMBINE is a procedure that takes one or more arguments and combines +all the alist entries into one value, @code{string-append} or +@code{append} are usually good candidates for this. + +See the @code{serialize-alist} procedure in `@code{(gnu home-services +version-control}' for an example usage.)}" + (apply combine + (map (generic-serialize-alist-entry serialize-field) fields))) diff --git a/guix/scripts/home/import.scm b/guix/scripts/home/import.scm index c977ec3861..611f580e85 100644 --- a/guix/scripts/home/import.scm +++ b/guix/scripts/home/import.scm @@ -46,17 +46,15 @@ (home-bash-configuration ,@(if (file-exists? rc) `((bashrc - (list (slurp-file-gexp (local-file ,rc))))) + (list (local-file ,rc)))) '()) ,@(if (file-exists? profile) `((bash-profile - (list (slurp-file-gexp - (local-file ,profile))))) + (list (local-file ,profile)))) '()) ,@(if (file-exists? logout) `((bash-logout - (list (slurp-file-gexp - (local-file ,logout))))) + (list (local-file ,logout)))) '())))))) -- 2.33.0