From patchwork Fri Aug 27 06:52:04 2021 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Andrew Tropin X-Patchwork-Id: 32329 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 00ACC27BBE3; Fri, 27 Aug 2021 07:54:19 +0100 (BST) X-Spam-Checker-Version: SpamAssassin 3.4.2 (2018-09-13) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-2.8 required=5.0 tests=BAYES_00,DKIM_SIGNED, MAILING_LIST_MULTI,RCVD_IN_MSPIKE_H2,SPF_HELO_PASS,T_DKIM_INVALID, URIBL_BLOCKED autolearn=unavailable autolearn_force=no version=3.4.2 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id 7843927BBE1 for ; Fri, 27 Aug 2021 07:54:19 +0100 (BST) Received: from localhost ([::1]:34428 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1mJVko-0002FV-IC for patchwork@mira.cbaines.net; Fri, 27 Aug 2021 02:54:18 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:48580) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1mJVja-0000UA-KB for guix-patches@gnu.org; Fri, 27 Aug 2021 02:53:02 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:39598) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1mJVja-000137-B7 for guix-patches@gnu.org; Fri, 27 Aug 2021 02:53:02 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1mJVja-0004mJ-A0 for guix-patches@gnu.org; Fri, 27 Aug 2021 02:53:02 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#50208] [PATCH 1/5] home-services: Add fontutils. Resent-From: Andrew Tropin Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Fri, 27 Aug 2021 06:53:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 50208 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: Oleg Pykhalov Cc: 50208@debbugs.gnu.org Received: via spool by 50208-submit@debbugs.gnu.org id=B50208.163004713718312 (code B ref 50208); Fri, 27 Aug 2021 06:53:02 +0000 Received: (at 50208) by debbugs.gnu.org; 27 Aug 2021 06:52:17 +0000 Received: from localhost ([127.0.0.1]:51144 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1mJVir-0004lI-Dc for submit@debbugs.gnu.org; Fri, 27 Aug 2021 02:52:17 -0400 Received: from mail-lf1-f53.google.com ([209.85.167.53]:39677) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1mJVio-0004l5-CZ for 50208@debbugs.gnu.org; Fri, 27 Aug 2021 02:52:15 -0400 Received: by mail-lf1-f53.google.com with SMTP id m28so12291704lfj.6 for <50208@debbugs.gnu.org>; Thu, 26 Aug 2021 23:52:14 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=trop-in.20150623.gappssmtp.com; s=20150623; h=from:to:cc:subject:in-reply-to:references:date:message-id :mime-version; bh=eLyXhxJPmm/YYN4NQ4JRserX+J1vPnUR9sNXJxtgNN0=; b=YBuj/+m+A6fB1rvDENIGjOnqCpZ4caJPtQnB8malo3DJQLEamQvFPjK3jdrUPDM2nv l3xKgefB8M5trrRDuQ9D9x96Cem2FhD64YbteMhpsvHX9G/s7lnMmOhELrUraYSStXyb KBLNPlBCMqsjylsLp4IxJ8RXopfz3+tEa9M65J9YnWz1TcNhefmSdznSLNMszXnE+xQr k02IJxUbtDuQU8OaBNGCoYgMi1FftucElwhlwdfYQlqGMTAUY0So28xlW9102G2SrWRX yxMeRvTlxuT6/iaRWe1ZmkKDOhMFn3wdTtnsbg8mtmGdCW1zmR3OQr9kcGxdAAdrFhq3 07Iw== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:from:to:cc:subject:in-reply-to:references:date :message-id:mime-version; bh=eLyXhxJPmm/YYN4NQ4JRserX+J1vPnUR9sNXJxtgNN0=; b=UUT4CLtXsEtKHJaSNZCVUGIupaHRNGw6g1N4etH/FL3+v/gHj52yVihIZmJ3ZPlcPN ORp2KM0gL2CB2krgoHfowZ+M3PME/Q4V3J45+xctVp/ejWXlU7dESoAoYrJNOtVU+Swe 4oqYKWaGQ3FG7rToWQbwIzvM1zbZZ6Toepz8UT/Vuem3cnsD0rNMBvdtUYd4NzQjspZ5 HQfC4wp0Wx5WEBi2GhE5L+l3QYTAupIZJD8IQidBC4GRgLylEEgtf1NlJbJS7QGbDliu VKE4Rz1OM2B67mzldGniIUGmSxTYwjjHSsNKFPtI534jskaaP6ssImOAqLQ1w5xdG4gz ArDA== X-Gm-Message-State: AOAM530BZbg60ZcB1p09nkuroisB3g1bXroGgLJXSDaKn1vxC6OO6QgP m0v8+hVNM+5bVcG8p4BEkl4+VbvN73L57A== X-Google-Smtp-Source: ABdhPJy8UbnMnLew2N+wZJoi0fzQL7QRlQiMbpvKtAw1KLjV/O7C+vKrXbbPmjQgK/G3QI9K6sSrkQ== X-Received: by 2002:ac2:51dd:: with SMTP id u29mr5482790lfm.171.1630047128281; Thu, 26 Aug 2021 23:52:08 -0700 (PDT) Received: from localhost (109-252-93-92.nat.spd-mgts.ru. [109.252.93.92]) by smtp.gmail.com with ESMTPSA id k35sm507496lfv.227.2021.08.26.23.52.07 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Thu, 26 Aug 2021 23:52:07 -0700 (PDT) From: Andrew Tropin In-Reply-To: <871r6ffklu.fsf@trop.in> References: <87bl5kbsk8.fsf@trop.in> <87r1eg8obm.fsf@gmail.com> <871r6ffklu.fsf@trop.in> Date: Fri, 27 Aug 2021 09:52:04 +0300 Message-ID: <87y28ne5wr.fsf@trop.in> 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" X-getmail-retrieved-from-mailbox: Patches * gnu/home-services/fontutils.scm (home-fontconfig-service-type): New variable. * gnu/local.mk (GNU_SYSTEM_MODULES): Add home-services/fontutils.scm. --- gnu/home-services/fontutils.scm | 65 +++++++++++++++++++++++++++++++++ gnu/local.mk | 1 + 2 files changed, 66 insertions(+) create mode 100644 gnu/home-services/fontutils.scm diff --git a/gnu/home-services/fontutils.scm b/gnu/home-services/fontutils.scm new file mode 100644 index 0000000000..28bfc3d3f7 --- /dev/null +++ b/gnu/home-services/fontutils.scm @@ -0,0 +1,65 @@ +;;; 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 fontutils) + #:use-module (gnu home-services) + #:use-module (gnu packages fontutils) + #:use-module (guix gexp) + + #:export (home-fontconfig-service-type)) + +;;; Commentary: +;;; +;;; Services related to fonts. home-fontconfig service provides +;;; fontconfig configuration, which allows fc-* utilities to find +;;; fonts in Guix Home's profile and regenerates font cache on +;;; activation. +;;; +;;; Code: + +(define (add-fontconfig-config-file he-symlink-path) + `(("config/fontconfig/fonts.conf" + ,(mixed-text-file + "fonts.conf" + " + + + ~/.guix-home/profile/share/fonts +")))) + +(define (regenerate-font-cache-gexp _) + `(("profile/share/fonts" + ,#~(system* #$(file-append fontconfig "/bin/fc-cache") "-fv")))) + +(define home-fontconfig-service-type + (service-type (name 'home-fontconfig) + (extensions + (list (service-extension + home-files-service-type + add-fontconfig-config-file) + (service-extension + home-run-on-change-service-type + regenerate-font-cache-gexp) + (service-extension + home-profile-service-type + (const (list fontconfig))))) + (default-value #f) + (description + "Provides configuration file for fontconfig and make +fc-* utilities aware of font packages installed in Guix Home's profile."))) diff --git a/gnu/local.mk b/gnu/local.mk index 91c3b0da3d..e25ff3db53 100644 --- a/gnu/local.mk +++ b/gnu/local.mk @@ -74,6 +74,7 @@ GNU_SYSTEM_MODULES = \ %D%/ci.scm \ %D%/home-services.scm \ %D%/home-services/symlink-manager.scm \ + %D%/home-services/fontutils.scm \ %D%/image.scm \ %D%/packages.scm \ %D%/packages/abduco.scm \ From patchwork Fri Aug 27 06:58:56 2021 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Andrew Tropin X-Patchwork-Id: 32330 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 8968727BBE3; Fri, 27 Aug 2021 08:04:01 +0100 (BST) X-Spam-Checker-Version: SpamAssassin 3.4.2 (2018-09-13) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-2.8 required=5.0 tests=BAYES_00,DKIM_SIGNED, MAILING_LIST_MULTI,RCVD_IN_MSPIKE_H2,SPF_HELO_PASS,T_DKIM_INVALID, URIBL_BLOCKED autolearn=unavailable autolearn_force=no version=3.4.2 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id 1952827BBE1 for ; Fri, 27 Aug 2021 08:04:01 +0100 (BST) Received: from localhost ([::1]:48238 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1mJVuC-00045l-1r for patchwork@mira.cbaines.net; Fri, 27 Aug 2021 03:04:00 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:49830) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1mJVqN-0000uV-Gn for guix-patches@gnu.org; Fri, 27 Aug 2021 03:00:03 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:39610) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1mJVqN-00073j-69 for guix-patches@gnu.org; Fri, 27 Aug 2021 03:00:03 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1mJVqN-0004wz-4u for guix-patches@gnu.org; Fri, 27 Aug 2021 03:00:03 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#50208] [PATCH 2/5] home-services: Add helper functions for service configurations. Resent-From: Andrew Tropin Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Fri, 27 Aug 2021 07:00:03 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 50208 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: Oleg Pykhalov Cc: 50208@debbugs.gnu.org Received: via spool by 50208-submit@debbugs.gnu.org id=B50208.163004754818916 (code B ref 50208); Fri, 27 Aug 2021 07:00:03 +0000 Received: (at 50208) by debbugs.gnu.org; 27 Aug 2021 06:59:08 +0000 Received: from localhost ([127.0.0.1]:51152 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1mJVpU-0004v1-Ge for submit@debbugs.gnu.org; Fri, 27 Aug 2021 02:59:08 -0400 Received: from mail-lf1-f54.google.com ([209.85.167.54]:37878) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1mJVpS-0004uU-VA for 50208@debbugs.gnu.org; Fri, 27 Aug 2021 02:59:07 -0400 Received: by mail-lf1-f54.google.com with SMTP id k5so12373645lfu.4 for <50208@debbugs.gnu.org>; Thu, 26 Aug 2021 23:59:06 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=trop-in.20150623.gappssmtp.com; s=20150623; h=from:to:cc:subject:in-reply-to:references:date:message-id :mime-version; bh=CNoa8R/wqF/C7RwVlyD3UBuiSq8rb3we2L7ipIXqM2Q=; b=YljrfKclsA1JJ31Q6qbcI8/0D4FuJNW3R3H65JgQq/YIHf3BSjtsiKPF9UaoYOFToP j7lN0kNh1ieXnZ/KgBJ3rColtKw6RMbjIouC+ZAAnGTR4ltOy66fZ2SVW/nGgfmB5Kvv u2VvXW6gOl0GSmlNC7MUSnthSfk6gBzjYyfSwNu0gkAXzyqlrvAFXByxseoHK4kcv7RU syAKEYa4CkePXfcTneWKD2eZmABv5v4HuU2D7I7JsqnGE9CkRGSCW6qSm/H9ssuZNrWz mu2en/gPYKtkDnbeOW3iW2Jrj9prrfCqPz4Meosrgp2d2rlW7MLYDaiy2fgns8x7AvTa X/eQ== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:from:to:cc:subject:in-reply-to:references:date :message-id:mime-version; bh=CNoa8R/wqF/C7RwVlyD3UBuiSq8rb3we2L7ipIXqM2Q=; b=U9Hm0uW7vWq+/cI+8uD4Q+JXyUR5/cwousZsvFc1Z28afXXFLGcCDzkHzub3Bgt9f0 gx6uvEFV48yzhS3YHSBl8iEWWkVHYdnSbn4NGwJHREB5ITyr5a2U2QnMsBViYUyDFx5d I+tLjQrbGXDLg3CYErYCP3gAk0K46+kYfEtCzu3jQ5t2b1UVAUR9OEngTxqrRBYqRzTw gteAC5h7Xq+Qch0Sh81p3VnW2f8Lola28EQXYV/cxdZzLxQpchldVJblacTUzU95BkVT cLFVeBjpgVpx5nsN+ZPj2DDCNfTGO1BA8SahJio2E9aYwFWCQRE9bJOCtJxKeTNxBDmQ QVTA== X-Gm-Message-State: AOAM5336w7K2qHvp9zcWyXej4EX9Xc4exbtfxoVj6PLvbYwVzv874UER KayPOgYWUaUbM1uIqo8jUN0ckg== X-Google-Smtp-Source: ABdhPJwK3N0R1yX013BXDalL4fJB6nFyhx+oPjn+ZZAeMdJwQ04cwxYqeU++f63jSAp3tEVkcLPWAQ== X-Received: by 2002:a05:6512:12c8:: with SMTP id p8mr2057763lfg.208.1630047540587; Thu, 26 Aug 2021 23:59:00 -0700 (PDT) Received: from localhost (109-252-93-92.nat.spd-mgts.ru. [109.252.93.92]) by smtp.gmail.com with ESMTPSA id z4sm508790lfu.164.2021.08.26.23.58.59 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Thu, 26 Aug 2021 23:58:59 -0700 (PDT) From: Andrew Tropin In-Reply-To: <871r6ffklu.fsf@trop.in> References: <87bl5kbsk8.fsf@trop.in> <87r1eg8obm.fsf@gmail.com> <871r6ffklu.fsf@trop.in> Date: Fri, 27 Aug 2021 09:58:56 +0300 Message-ID: <87v93re5lb.fsf@trop.in> 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" X-getmail-retrieved-from-mailbox: Patches * gnu/home-services/configuration.scm (helper functions): New variables. * gnu/local.mk (GNU_SYSTEM_MODULES): Add home-services/configuration.scm. --- gnu/home-services/configuration.scm | 63 +++++++++++++++++++++++++++++ gnu/local.mk | 1 + 2 files changed, 64 insertions(+) create mode 100644 gnu/home-services/configuration.scm diff --git a/gnu/home-services/configuration.scm b/gnu/home-services/configuration.scm new file mode 100644 index 0000000000..b7487fc49f --- /dev/null +++ b/gnu/home-services/configuration.scm @@ -0,0 +1,63 @@ +(define-module (gnu home-services configuration) + #:use-module (gnu services configuration) + #:use-module (guix gexp) + #:use-module (srfi srfi-1) + + #:export (filter-configuration-fields + + interpose + list-of + + list-of-strings? + alist? + string-or-gexp? + serialize-string-or-gexp + text-config? + serialize-text-config)) + +(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))) diff --git a/gnu/local.mk b/gnu/local.mk index e25ff3db53..e24da4716f 100644 --- a/gnu/local.mk +++ b/gnu/local.mk @@ -75,6 +75,7 @@ GNU_SYSTEM_MODULES = \ %D%/home-services.scm \ %D%/home-services/symlink-manager.scm \ %D%/home-services/fontutils.scm \ + %D%/home-services/configuration.scm \ %D%/image.scm \ %D%/packages.scm \ %D%/packages/abduco.scm \ From patchwork Fri Aug 27 07:03:02 2021 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Andrew Tropin X-Patchwork-Id: 32331 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 6C0D727BBE3; Fri, 27 Aug 2021 08:04:31 +0100 (BST) X-Spam-Checker-Version: SpamAssassin 3.4.2 (2018-09-13) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-2.8 required=5.0 tests=BAYES_00,DKIM_SIGNED, MAILING_LIST_MULTI,RCVD_IN_MSPIKE_H2,SPF_HELO_PASS,T_DKIM_INVALID, URIBL_BLOCKED autolearn=unavailable autolearn_force=no version=3.4.2 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id 4AC2A27BBE1 for ; Fri, 27 Aug 2021 08:04:30 +0100 (BST) Received: from localhost ([::1]:49148 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1mJVuf-0004lM-Dr for patchwork@mira.cbaines.net; Fri, 27 Aug 2021 03:04:29 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:50800) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1mJVuE-0004FN-1A for guix-patches@gnu.org; Fri, 27 Aug 2021 03:04:02 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:39620) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1mJVuD-0001um-Pi for guix-patches@gnu.org; Fri, 27 Aug 2021 03:04:01 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1mJVuD-00054K-L6 for guix-patches@gnu.org; Fri, 27 Aug 2021 03:04:01 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#50208] [PATCH 3/5] home-services: Add shells. Resent-From: Andrew Tropin Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Fri, 27 Aug 2021 07:04:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 50208 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: Oleg Pykhalov Cc: 50208@debbugs.gnu.org Received: via spool by 50208-submit@debbugs.gnu.org id=B50208.163004779919427 (code B ref 50208); Fri, 27 Aug 2021 07:04:01 +0000 Received: (at 50208) by debbugs.gnu.org; 27 Aug 2021 07:03:19 +0000 Received: from localhost ([127.0.0.1]:51166 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1mJVtT-00053C-9O for submit@debbugs.gnu.org; Fri, 27 Aug 2021 03:03:18 -0400 Received: from mail-lf1-f47.google.com ([209.85.167.47]:34461) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1mJVtQ-00052w-8M for 50208@debbugs.gnu.org; Fri, 27 Aug 2021 03:03:13 -0400 Received: by mail-lf1-f47.google.com with SMTP id z2so12425747lft.1 for <50208@debbugs.gnu.org>; Fri, 27 Aug 2021 00:03:12 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=trop-in.20150623.gappssmtp.com; s=20150623; h=from:to:cc:subject:in-reply-to:references:date:message-id :mime-version; bh=kFkAQq51sY6nnz0UzrjbQb5vPCTDMxq0alEm43CDP/g=; b=xHbwATZ6uWJ8PdJNRb8jUO575orsBtFsHV7vV21bVVlFw3k7GHtisO5CHwAl0KIzux RkKY4Zz4xUnHeTUzbP5KfjaA1VwQ0XHZZtmhNsAnpsB2TbM8b4X5/zkWhNj05STJ+YP4 HLRPeUnRUDQFiP2WcfDTkjzoLGZ6jmsjUrv0fofBScBJQPaZVdpmVAaLAgJ/gCLhzCYl CaxQmrLV6RcY/qgliHxhnecuc/XC2bDjNR5LFnVIdA2VugAKrTH1VHX9udnUsLvLQ9nn bRJnAjeegETEyf+9SdXlYGUGWAgfagEM9O9UPL+X9zXdrXg6XKR9nUiYXoYP15BCOUS3 eP8A== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:from:to:cc:subject:in-reply-to:references:date :message-id:mime-version; bh=kFkAQq51sY6nnz0UzrjbQb5vPCTDMxq0alEm43CDP/g=; b=YWXHL2ZZh87fO6mi81gYEfmF68l0exPmzPiHdD/A6riIfUTeEgKbDblqI2P3kQCZKZ jGjCvygn5kOp8NU3g18DWx6wx6gDp4B1Zpu9RJXkCR3TZ4mPAutLtyocZF7IXzgdS7rS xnv1eqMb1tTS03s9/64gO5OYptpgTNdb1qwsK86+kmaJPqUsmXYdUC9iyA1WftQeNiy/ d6XDIMkYazCLCb6MuJGnK5rqoJdFjMQSD7eRe2n6qT8VXpheYESsrk7DdZbMpmaLTIiS 5fTBhSuqrUEJFwTFMAH4S3V0iNkyCvwuhUPN1Yal5FBhxcg1TBoLIjcLwG3v5RbcAMMs XH2Q== X-Gm-Message-State: AOAM531bbdXot3R5u5cn0tyWWomLOcMMXyrmneRsqT2sxjjvJjYmzU5L yySp5ja7k3F5IXOeOe5jhkrVEsfVsixSBw== X-Google-Smtp-Source: ABdhPJxIPBH1SyXvScMJraROLn1Xwp8+lyFzf8fQzmd0UtXjMDCGm9ZXvuyp1GfpNXVmi3nSyir24Q== X-Received: by 2002:a19:4f1a:: with SMTP id d26mr5427643lfb.377.1630047786281; Fri, 27 Aug 2021 00:03:06 -0700 (PDT) Received: from localhost (109-252-93-92.nat.spd-mgts.ru. [109.252.93.92]) by smtp.gmail.com with ESMTPSA id e8sm582872ljj.132.2021.08.27.00.03.05 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Fri, 27 Aug 2021 00:03:05 -0700 (PDT) From: Andrew Tropin In-Reply-To: <871r6ffklu.fsf@trop.in> References: <87bl5kbsk8.fsf@trop.in> <87r1eg8obm.fsf@gmail.com> <871r6ffklu.fsf@trop.in> Date: Fri, 27 Aug 2021 10:03:02 +0300 Message-ID: <87r1efe5eh.fsf@trop.in> 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" X-getmail-retrieved-from-mailbox: Patches * gnu/home-services/shells.scm (home-shell-profile-service-type, home-shell-profile-configuration) (home-bash-service-type, home-bash-configuration, home-bash-extension) (home-zsh-service-type, home-zsh-configuration, home-zsh-extension) (home-fish-service-type, home-fish-configuration, home-fish-extension): New variables. * gnu/local.mk (GNU_SYSTEM_MODULES): Add home-services/shells.scm. --- gnu/home-services/shells.scm | 637 +++++++++++++++++++++++++++++++++++ gnu/local.mk | 1 + 2 files changed, 638 insertions(+) create mode 100644 gnu/home-services/shells.scm diff --git a/gnu/home-services/shells.scm b/gnu/home-services/shells.scm new file mode 100644 index 0000000000..0643019361 --- /dev/null +++ b/gnu/home-services/shells.scm @@ -0,0 +1,637 @@ +;;; 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 shells) + #:use-module (gnu services configuration) + #:use-module (gnu home-services configuration) + #:use-module (gnu home-services) + #:use-module (gnu packages shells) + #:use-module (gnu packages bash) + #:use-module (guix gexp) + #:use-module (guix packages) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-26) + #:use-module (ice-9 match) + + #:export (home-shell-profile-service-type + home-shell-profile-configuration + + home-bash-service-type + home-bash-configuration + home-bash-extension + + home-zsh-service-type + home-zsh-configuration + home-zsh-extension + + home-fish-service-type + home-fish-configuration + home-fish-extension)) + +;;; Commentary: +;;; +;;; This module contains shell related services like Zsh. +;;; +;;; Code: + + +;;; +;;; Shell profile. +;;; + +(define path? string?) +(define (serialize-path field-name val) val) + +(define-configuration home-shell-profile-configuration + (profile + (text-config '()) + "\ +@code{home-shell-profile} is instantiated automatically by +@code{home-environment}, DO NOT create this service manually, it can +only be extended. + +@code{profile} is a list of strings or gexps, which will go to +@file{~/.profile}. By default @file{~/.profile} contains the +initialization code, which have to be evaluated by login shell to make +home-environment's profile avaliable to the user, but other commands +can be added to the file if it is really necessary. + +In most cases shell's configuration files are preferred places for +user's customizations. Extend home-shell-profile service only if you +really know what you do.")) + +(define (add-shell-profile-file config) + `(("profile" + ,(mixed-text-file + "shell-profile" + "\ +HOME_ENVIRONMENT=$HOME/.guix-home +. $HOME_ENVIRONMENT/setup-environment +$HOME_ENVIRONMENT/on-first-login\n" + (serialize-configuration + config + (filter-configuration-fields + home-shell-profile-configuration-fields '(profile))))))) + +(define (add-profile-extensions config extensions) + (home-shell-profile-configuration + (inherit config) + (profile + (append (home-shell-profile-configuration-profile config) + extensions)))) + +(define home-shell-profile-service-type + (service-type (name 'home-shell-profile) + (extensions + (list (service-extension + home-files-service-type + add-shell-profile-file))) + (compose concatenate) + (extend add-profile-extensions) + (default-value (home-shell-profile-configuration)) + (description "Create @file{~/.profile}, which is used +for environment initialization of POSIX compliant login shells. This +service type can be extended with a list of strings or gexps."))) + +(define (serialize-boolean field-name val) "") +(define (serialize-posix-env-vars field-name val) + #~(string-append + #$@(map + (match-lambda + ((key . #f) + "") + ((key . #t) + #~(string-append "export " #$key "\n")) + ((key . value) + #~(string-append "export " #$key "=" #$value "\n"))) + val))) + + +;;; +;;; Zsh. +;;; + +(define-configuration home-zsh-configuration + (package + (package zsh) + "The Zsh package to use.") + (xdg-flavor? + (boolean #t) + "Place all the configs to @file{$XDG_CONFIG_HOME/zsh}. Makes +@file{~/.zshenv} to set @env{ZDOTDIR} to @file{$XDG_CONFIG_HOME/zsh}. +Shell startup process will continue with +@file{$XDG_CONFIG_HOME/zsh/.zshenv}.") + (environment-variables + (alist '()) + "Association list of environment variables to set for the Zsh session." + serialize-posix-env-vars) + (zshenv + (text-config '()) + "List of strings or gexps, which will be added to @file{.zshenv}. +Used for setting user's shell environment variables. Must not contain +commands assuming the presence of tty or producing output. Will be +read always. Will be read before any other file in @env{ZDOTDIR}.") + (zprofile + (text-config '()) + "List of strings or gexps, which will be added to @file{.zprofile}. +Used for executing user's commands at start of login shell (In most +cases the shell started on tty just after login). Will be read before +@file{.zlogin}.") + (zshrc + (text-config '()) + "List of strings or gexps, which will be added to @file{.zshrc}. +Used for executing user's commands at start of interactive shell (The +shell for interactive usage started by typing @code{zsh} or by +terminal app or any other program).") + (zlogin + (text-config '()) + "List of strings or gexps, which will be added to @file{.zlogin}. +Used for executing user's commands at the end of starting process of +login shell.") + (zlogout + (text-config '()) + "List of strings or gexps, which will be added to @file{.zlogout}. +Used for executing user's commands at the exit of login shell. It +won't be read in some cases (if the shell terminates by exec'ing +another process for example).")) + +(define (add-zsh-configuration config) + (let* ((xdg-flavor? (home-zsh-configuration-xdg-flavor? config))) + + (define prefix-file + (cut string-append + (if xdg-flavor? + "config/zsh/." + "") <>)) + + (define (filter-fields field) + (filter-configuration-fields home-zsh-configuration-fields + (list field))) + + (define (serialize-field field) + (serialize-configuration + config + (filter-fields field))) + + (define (file-if-not-empty field) + (let ((file-name (symbol->string field)) + (field-obj (car (filter-fields field)))) + (if (not (null? ((configuration-field-getter field-obj) config))) + `(,(prefix-file file-name) + ,(mixed-text-file + file-name + (serialize-field field))) + '()))) + + (filter + (compose not null?) + `(,(if xdg-flavor? + `("zshenv" + ,(mixed-text-file + "auxiliary-zshenv" + (if xdg-flavor? + "source ${XDG_CONFIG_HOME:-$HOME/.config}/zsh/.zshenv\n" + ""))) + '()) + (,(prefix-file "zshenv") + ,(mixed-text-file + "zshenv" + (if xdg-flavor? + "export ZDOTDIR=${XDG_CONFIG_HOME:-$HOME/.config}/zsh\n" + "") + (serialize-field 'zshenv) + (serialize-field 'environment-variables))) + (,(prefix-file "zprofile") + ,(mixed-text-file + "zprofile" + "\ +# Setups system and user profiles and related variables +source /etc/profile +# Setups home environment profile +source ~/.profile + +# It's only necessary if zsh is a login shell, otherwise profiles will +# be already sourced by bash +" + (serialize-field 'zprofile))) + + ,@(list (file-if-not-empty 'zshrc) + (file-if-not-empty 'zlogin) + (file-if-not-empty 'zlogout)))))) + +(define (add-zsh-packages config) + (list (home-zsh-configuration-package config))) + +(define-configuration/no-serialization home-zsh-extension + (environment-variables + (alist '()) + "Association list of environment variables to set.") + (zshrc + (text-config '()) + "List of strings or gexps.") + (zshenv + (text-config '()) + "List of strings or gexps.") + (zprofile + (text-config '()) + "List of strings or gexps.") + (zlogin + (text-config '()) + "List of strings or gexps.") + (zlogout + (text-config '()) + "List of strings or gexps.")) + +(define (home-zsh-extensions original-config extension-configs) + (home-zsh-configuration + (inherit original-config) + (environment-variables + (append (home-zsh-configuration-environment-variables original-config) + (append-map + home-zsh-extension-environment-variables extension-configs))) + (zshrc + (append (home-zsh-configuration-zshrc original-config) + (append-map + home-zsh-extension-zshrc extension-configs))) + (zshenv + (append (home-zsh-configuration-zshenv original-config) + (append-map + home-zsh-extension-zshenv extension-configs))) + (zprofile + (append (home-zsh-configuration-zprofile original-config) + (append-map + home-zsh-extension-zprofile extension-configs))) + (zlogin + (append (home-zsh-configuration-zlogin original-config) + (append-map + home-zsh-extension-zlogin extension-configs))) + (zlogout + (append (home-zsh-configuration-zlogout original-config) + (append-map + home-zsh-extension-zlogout extension-configs))))) + +(define home-zsh-service-type + (service-type (name 'home-zsh) + (extensions + (list (service-extension + home-files-service-type + add-zsh-configuration) + (service-extension + home-profile-service-type + add-zsh-packages))) + (compose identity) + (extend home-zsh-extensions) + (default-value (home-zsh-configuration)) + (description "Install and configure Zsh."))) + + +;;; +;;; Bash. +;;; + +(define-configuration home-bash-configuration + (package + (package bash) + "The Bash package to use.") + (guix-defaults? + (boolean #t) + "Add sane defaults like reading @file{/etc/bashrc}, coloring output +for @code{ls} provided by guix to @file{.bashrc}.") + (environment-variables + (alist '()) + "Association list of environment variables to set for the Bash session." + serialize-posix-env-vars) + (bash-profile + (text-config '()) + "List of strings or gexps, which will be added to @file{.bash_profile}. +Used for executing user's commands at start of login shell (In most +cases the shell started on tty just after login). @file{.bash_login} +won't be ever read, because @file{.bash_profile} always present.") + (bashrc + (text-config '()) + "List of strings or gexps, which will be added to @file{.bashrc}. +Used for executing user's commands at start of interactive shell (The +shell for interactive usage started by typing @code{bash} or by +terminal app or any other program).") + (bash-logout + (text-config '()) + "List of strings or gexps, which will be added to @file{.bash_logout}. +Used for executing user's commands at the exit of login shell. It +won't be read in some cases (if the shell terminates by exec'ing +another process for example).")) + +;; TODO: Use value from (gnu system shadow) +(define guix-bashrc + "\ +# Bash initialization for interactive non-login shells and +# for remote shells (info \"(bash) Bash Startup Files\"). + +# Export 'SHELL' to child processes. Programs such as 'screen' +# honor it and otherwise use /bin/sh. +export SHELL + +if [[ $- != *i* ]] +then + # We are being invoked from a non-interactive shell. If this + # is an SSH session (as in \"ssh host command\"), source + # /etc/profile so we get PATH and other essential variables. + [[ -n \"$SSH_CLIENT\" ]] && source /etc/profile + + # Don't do anything else. + return +fi + +# Source the system-wide file. +source /etc/bashrc + +# Adjust the prompt depending on whether we're in 'guix environment'. +if [ -n \"$GUIX_ENVIRONMENT\" ] +then + PS1='\\u@\\h \\w [env]\\$ ' +else + PS1='\\u@\\h \\w\\$ ' +fi +alias ls='ls -p --color=auto' +alias ll='ls -l' +alias grep='grep --color=auto'\n") + +(define (add-bash-configuration config) + (define (filter-fields field) + (filter-configuration-fields home-bash-configuration-fields + (list field))) + + (define (serialize-field field) + (serialize-configuration + config + (filter-fields field))) + + (define* (file-if-not-empty field #:optional (extra-content #f)) + (let ((file-name (symbol->string field)) + (field-obj (car (filter-fields field)))) + (if (or extra-content + (not (null? ((configuration-field-getter field-obj) config)))) + `(,(object->snake-case-string file-name) + ,(mixed-text-file + (object->snake-case-string file-name) + (if extra-content extra-content "") + (serialize-field field))) + '()))) + + (filter + (compose not null?) + `(("bash_profile" + ,(mixed-text-file + "bash_profile" + "\ +# Setups system and user profiles and related variables +# /etc/profile will be sourced by bash automatically +# Setups home environment profile +if [ -f ~/.profile ]; then source ~/.profile; fi + +# Honor per-interactive-shell startup file +if [ -f ~/.bashrc ]; then source ~/.bashrc; fi +" + (serialize-field 'bash-profile) + (serialize-field 'environment-variables))) + + ,@(list (file-if-not-empty + 'bashrc + (if (home-bash-configuration-guix-defaults? config) + guix-bashrc + #f)) + (file-if-not-empty 'bash-logout))))) + +(define (add-bash-packages config) + (list (home-bash-configuration-package config))) + +(define-configuration/no-serialization home-bash-extension + (environment-variables + (alist '()) + "Association list of environment variables to set.") + (bash-profile + (text-config '()) + "List of strings or gexps.") + (bashrc + (text-config '()) + "List of strings or gexps.") + (bash-logout + (text-config '()) + "List of strings or gexps.")) + +(define (home-bash-extensions original-config extension-configs) + (home-bash-configuration + (inherit original-config) + (environment-variables + (append (home-bash-configuration-environment-variables original-config) + (append-map + home-bash-extension-environment-variables extension-configs))) + (bash-profile + (append (home-bash-configuration-bash-profile original-config) + (append-map + home-bash-extension-bash-profile extension-configs))) + (bashrc + (append (home-bash-configuration-bashrc original-config) + (append-map + home-bash-extension-bashrc extension-configs))) + (bash-logout + (append (home-bash-configuration-bash-logout original-config) + (append-map + home-bash-extension-bash-logout extension-configs))))) + +(define home-bash-service-type + (service-type (name 'home-bash) + (extensions + (list (service-extension + home-files-service-type + add-bash-configuration) + (service-extension + home-profile-service-type + add-bash-packages))) + (compose identity) + (extend home-bash-extensions) + (default-value (home-bash-configuration)) + (description "Install and configure GNU Bash."))) + + +;;; +;;; Fish. +;;; + +(define (serialize-fish-aliases field-name val) + #~(string-append + #$@(map (match-lambda + ((key . value) + #~(string-append "alias " #$key " \"" #$value "\"\n")) + (_ "")) + val))) + +(define (serialize-fish-abbreviations field-name val) + #~(string-append + #$@(map (match-lambda + ((key . value) + #~(string-append "abbr --add " #$key " " #$value "\n")) + (_ "")) + val))) + +(define (serialize-fish-env-vars field-name val) + #~(string-append + #$@(map (match-lambda + ((key . #f) + "") + ((key . #t) + #~(string-append "set " #$key "\n")) + ((key . value) + #~(string-append "set " #$key " " #$value "\n"))) + val))) + +(define-configuration home-fish-configuration + (package + (package fish) + "The Fish package to use.") + (config + (text-config '()) + "List of strings or gexps, which will be added to +@file{$XDG_CONFIG_HOME/fish/config.fish}.") + (environment-variables + (alist '()) + "Association list of environment variables to set in Fish." + serialize-fish-env-vars) + (aliases + (alist '()) + "Association list of aliases for Fish, both the key and the value +should be a string. An alias is just a simple function that wraps a +command, If you want something more akin to @dfn{aliases} in POSIX +shells, see the @code{abbreviations} field." + serialize-fish-aliases) + (abbreviations + (alist '()) + "Association list of abbreviations for Fish. These are words that, +when typed in the shell, will automatically expand to the full text." + serialize-fish-abbreviations)) + +(define (fish-files-service config) + `(("config/fish/config.fish" + ,(mixed-text-file + "fish-config.fish" + #~(string-append "\ +# if we haven't sourced the login config, do it +status --is-login; and not set -q __fish_login_config_sourced +and begin + + set --prepend fish_function_path " + #$fish-foreign-env + "/share/fish/functions + fenv source $HOME/.profile + set -e fish_function_path[1] + + set -g __fish_login_config_sourced 1 + +end\n\n") + (serialize-configuration + config + home-fish-configuration-fields))))) + +(define (fish-profile-service config) + (list (home-fish-configuration-package config))) + +(define-configuration/no-serialization home-fish-extension + (config + (text-config '()) + "List of strings or gexps for extending the Fish initialization file.") + (environment-variables + (alist '()) + "Association list of environment variables to set.") + (aliases + (alist '()) + "Association list of Fish aliases.") + (abbreviations + (alist '()) + "Association list of Fish abbreviations.")) + +(define (home-fish-extensions original-config extension-configs) + (home-fish-configuration + (inherit original-config) + (config + (append (home-fish-configuration-config original-config) + (append-map + home-fish-extension-config extension-configs))) + (environment-variables + (append (home-fish-configuration-environment-variables original-config) + (append-map + home-fish-extension-environment-variables extension-configs))) + (aliases + (append (home-fish-configuration-aliases original-config) + (append-map + home-fish-extension-aliases extension-configs))) + (abbreviations + (append (home-fish-configuration-abbreviations original-config) + (append-map + home-fish-extension-abbreviations extension-configs))))) + +;; TODO: Support for generating completion files +;; TODO: Support for installing plugins +(define home-fish-service-type + (service-type (name 'home-fish) + (extensions + (list (service-extension + home-files-service-type + fish-files-service) + (service-extension + home-profile-service-type + fish-profile-service))) + (compose identity) + (extend home-fish-extensions) + (default-value (home-fish-configuration)) + (description "\ +Install and configure Fish, the friendly interactive shell."))) + + +(define (generate-home-shell-profile-documentation) + (generate-documentation + `((home-shell-profile-configuration + ,home-shell-profile-configuration-fields)) + 'home-shell-profile-configuration)) + +(define (generate-home-bash-documentation) + (generate-documentation + `((home-bash-configuration + ,home-bash-configuration-fields)) + 'home-bash-configuration)) + +(define (generate-home-zsh-documentation) + (generate-documentation + `((home-zsh-configuration + ,home-zsh-configuration-fields)) + 'home-zsh-configuration)) + +(define (generate-home-fish-documentation) + (string-append + (generate-documentation + `((home-fish-configuration + ,home-fish-configuration-fields)) + 'home-fish-configuration) + "\n\n" + (generate-documentation + `((home-fish-extension + ,home-fish-extension-fields)) + 'home-fish-extension))) + +;; (display (generate-home-shell-profile-documentation)) +;; (display (generate-home-bash-documentation)) +;; (display (generate-home-zsh-documentation)) diff --git a/gnu/local.mk b/gnu/local.mk index e24da4716f..dc0e732114 100644 --- a/gnu/local.mk +++ b/gnu/local.mk @@ -76,6 +76,7 @@ GNU_SYSTEM_MODULES = \ %D%/home-services/symlink-manager.scm \ %D%/home-services/fontutils.scm \ %D%/home-services/configuration.scm \ + %D%/home-services/shells.scm \ %D%/image.scm \ %D%/packages.scm \ %D%/packages/abduco.scm \ From patchwork Fri Aug 27 07:06:50 2021 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Andrew Tropin X-Patchwork-Id: 32332 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 0E56227BBE3; Fri, 27 Aug 2021 08:08:11 +0100 (BST) X-Spam-Checker-Version: SpamAssassin 3.4.2 (2018-09-13) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-2.8 required=5.0 tests=BAYES_00,DKIM_SIGNED, MAILING_LIST_MULTI,RCVD_IN_MSPIKE_H2,SPF_HELO_PASS,T_DKIM_INVALID, URIBL_BLOCKED autolearn=unavailable autolearn_force=no version=3.4.2 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id 022D827BBE1 for ; Fri, 27 Aug 2021 08:08:10 +0100 (BST) Received: from localhost ([::1]:54332 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1mJVyD-00008W-3T for patchwork@mira.cbaines.net; Fri, 27 Aug 2021 03:08:09 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:51728) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1mJVy6-00008C-I3 for guix-patches@gnu.org; Fri, 27 Aug 2021 03:08:02 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:39629) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1mJVy6-0005k2-Ah for guix-patches@gnu.org; Fri, 27 Aug 2021 03:08:02 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1mJVy6-0005AU-5p for guix-patches@gnu.org; Fri, 27 Aug 2021 03:08:02 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#50208] [PATCH 4/5] home-services: Add xdg. Resent-From: Andrew Tropin Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Fri, 27 Aug 2021 07:08:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 50208 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: Oleg Pykhalov Cc: 50208@debbugs.gnu.org Received: via spool by 50208-submit@debbugs.gnu.org id=B50208.163004802719790 (code B ref 50208); Fri, 27 Aug 2021 07:08:02 +0000 Received: (at 50208) by debbugs.gnu.org; 27 Aug 2021 07:07:07 +0000 Received: from localhost ([127.0.0.1]:51172 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1mJVx8-000593-AA for submit@debbugs.gnu.org; Fri, 27 Aug 2021 03:07:07 -0400 Received: from mail-lf1-f48.google.com ([209.85.167.48]:46761) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1mJVx6-00058W-E4 for 50208@debbugs.gnu.org; Fri, 27 Aug 2021 03:07:01 -0400 Received: by mail-lf1-f48.google.com with SMTP id b4so12297788lfo.13 for <50208@debbugs.gnu.org>; Fri, 27 Aug 2021 00:07:00 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=trop-in.20150623.gappssmtp.com; s=20150623; h=from:to:cc:subject:in-reply-to:references:date:message-id :mime-version; bh=gmoMZIrynZ5Vwl10BB60DvhXTBZob5pPvdtZxvYUdbc=; b=rVIXyCq+rqCTp41aBiQUBV6/Qsu5F+3CuIzdXkl8W63A/Y25jIcv6NbG+Bs/bycA64 rypAqpyyL/EoXz8RQmqvN0tCZvVa5DLxJf745IabvcpUi06veS7wX72mG5AHj08lKnIv gYN0Io/npZwqmJP007gnYkEbZW0xYcpT7gVFh/tU2OucNgvjFflTkJUuCxVZc2yzquko Tv9FJf1qheq5ajPA+kKEjKDFtrSflzoUfuk2Z1RxCjp0OjdtoeBDFA0fdTaglplhYyO9 0zA9UMfbdgv/dlST6agoD15YThkvt1f8Rd9BWasMAjOEC9Fg6dtfn3H4gLC+s7VZmxth jBWw== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:from:to:cc:subject:in-reply-to:references:date :message-id:mime-version; bh=gmoMZIrynZ5Vwl10BB60DvhXTBZob5pPvdtZxvYUdbc=; b=PZWzxdQXW41vrxfDK9OzlqTMyo3OdOg2PTux9dfOMt44teELRVnI4kfgv1W0Ne4Qk3 j5LZAMxoBUFnp4WDHchM+x/N/EFkgMzuQ/bw0GC6FcfxMEz8pv1o1RI4VbM8J+/JlQem Fg7y4IDvkUYTEPYCjeOAjI3RBpXx0xVEqPlkIU3E2n+LCwzsapdj4xNdnfjndTsaWm0z 24XewF+v/+k9oHMbmopPd4c/8aWmkBkV0HugFNcSgnaR7wqFG/4hh2FOzJQgUXfo6UpG R5aIosDG2vzBB4x1IjgiAolTpqNLYjU/PZr2KrBZpJMyma0uJiaQ2GEJ1Tgy4AqDWScq NnIA== X-Gm-Message-State: AOAM532naSM8FUIZVeW0lFGjUQLyaX3aiYbWqjMC1jgeeCC/oNYyB/Bv UpC+u55APzOVyxkyMCPvIlNUWy1L3oVMgA== X-Google-Smtp-Source: ABdhPJw79qYRx+CemY3Mq9/YKTcvZ7Zcd3R1a+p4578qrM2iL5pdgX4dvS8SnggYXc/EcghBYKXKCg== X-Received: by 2002:ac2:4312:: with SMTP id l18mr5903188lfh.602.1630048013936; Fri, 27 Aug 2021 00:06:53 -0700 (PDT) Received: from localhost (109-252-93-92.nat.spd-mgts.ru. [109.252.93.92]) by smtp.gmail.com with ESMTPSA id i5sm588355ljm.33.2021.08.27.00.06.52 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Fri, 27 Aug 2021 00:06:53 -0700 (PDT) From: Andrew Tropin In-Reply-To: <871r6ffklu.fsf@trop.in> References: <87bl5kbsk8.fsf@trop.in> <87r1eg8obm.fsf@gmail.com> <871r6ffklu.fsf@trop.in> Date: Fri, 27 Aug 2021 10:06:50 +0300 Message-ID: <87o89je585.fsf@trop.in> 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" X-getmail-retrieved-from-mailbox: Patches * gnu/home-services/xdg.scm (home-xdg-base-directories-service-type) (home-xdg-base-directories-configuration) (home-xdg-base-directories-configuration?) (home-xdg-user-directories-service-type) (home-xdg-user-directories-configuration) (home-xdg-user-directories-configuration?) (xdg-desktop-action, xdg-desktop-entry) (home-xdg-mime-applications-service-type) (home-xdg-mime-applications-configuration): New variables. * gnu/local.mk (GNU_SYSTEM_MODULES): Add home-services/xdg.scm. --- gnu/home-services/xdg.scm | 475 ++++++++++++++++++++++++++++++++++++++ gnu/local.mk | 1 + 2 files changed, 476 insertions(+) create mode 100644 gnu/home-services/xdg.scm diff --git a/gnu/home-services/xdg.scm b/gnu/home-services/xdg.scm new file mode 100644 index 0000000000..acacaa1218 --- /dev/null +++ b/gnu/home-services/xdg.scm @@ -0,0 +1,475 @@ +;;; 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 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) + #:use-module (guix gexp) + #:use-module (guix records) + #:use-module (guix i18n) + + #:use-module (ice-9 match) + #:use-module (srfi srfi-1) + #:use-module (rnrs enums) + + #:export (home-xdg-base-directories-service-type + home-xdg-base-directories-configuration + home-xdg-base-directories-configuration? + + home-xdg-user-directories-service-type + home-xdg-user-directories-configuration + home-xdg-user-directories-configuration? + + xdg-desktop-action + xdg-desktop-entry + home-xdg-mime-applications-service-type + home-xdg-mime-applications-configuration)) + +;;; Commentary: +;; +;; This module contains services related to XDG directories and +;; applications. +;; +;; - XDG base directories +;; - XDG user directories +;; - XDG MIME applications +;; +;;; Code: + + +;;; +;;; XDG base directories. +;;; + +(define (serialize-path field-name val) "") +(define path? string?) + +(define-configuration home-xdg-base-directories-configuration + (cache-home + (path "$HOME/.cache") + "Base directory for programs to store user-specific non-essential +(cached) data. Files in this directory can be deleted anytime without +loss of important data.") + (config-home + (path "$HOME/.config") + "Base directory for programs to store configuration files. +Some programs store here log or state files, but it's not desired, +this directory should contain static configurations.") + (data-home + (path "$HOME/.local/share") + "Base directory for programs to store architecture independent +read-only shared data, analogus to @file{/usr/share}, but for user.") + (runtime-dir + (path "${XDG_RUNTIME_DIR:-/run/user/$UID}") + "Base directory for programs to store user-specific runtime files, +like sockets.") + (log-home + (path "$HOME/.local/var/log") + "Base directory for programs to store log files, analogus to +@file{/var/log}, but for user. It is not a part of XDG Base Directory +Specification, but helps to make implementation of home services more +consistent.") + (state-home + (path "$HOME/.local/var/lib") + "Base directory for programs to store state files, like databases, +analogus to @file{/var/lib}, but for user. It is not a part of XDG +Base Directory Specification, but helps to make implementation of home +services more consistent.")) + +(define (home-xdg-base-directories-environment-variables-service config) + (map + (lambda (field) + (cons (format + #f "XDG_~a" + (object->snake-case-string (configuration-field-name field) 'upper)) + ((configuration-field-getter field) config))) + home-xdg-base-directories-configuration-fields)) + +(define (ensure-xdg-base-dirs-on-activation config) + #~(map (lambda (xdg-base-dir-variable) + ((@@ (guix build utils) mkdir-p) + (getenv + xdg-base-dir-variable))) + '#$(map (lambda (field) + (format + #f "XDG_~a" + (object->snake-case-string + (configuration-field-name field) 'upper))) + home-xdg-base-directories-configuration-fields))) + +(define (last-extension-or-cfg config extensions) + "Picks configuration value from last provided extension. If there +are no extensions use configuration instead." + (or (and (not (null? extensions)) (last extensions)) config)) + +(define home-xdg-base-directories-service-type + (service-type (name 'home-xdg-base-directories) + (extensions + (list (service-extension + home-environment-variables-service-type + home-xdg-base-directories-environment-variables-service) + (service-extension + home-activation-service-type + ensure-xdg-base-dirs-on-activation))) + (default-value (home-xdg-base-directories-configuration)) + (compose identity) + (extend last-extension-or-cfg) + (description "Configure XDG base directories. This +service introduces two additional variables @env{XDG_STATE_HOME}, +@env{XDG_LOG_HOME}. They are not a part of XDG specification, at +least yet, but are convinient to have, it improves the consistency +between different home services. The services of this service-type is +instantiated by default, to provide non-default value, extend the +service-type (using @code{simple-service} for example)."))) + +(define (generate-home-xdg-base-directories-documentation) + (generate-documentation + `((home-xdg-base-directories-configuration + ,home-xdg-base-directories-configuration-fields)) + 'home-xdg-base-directories-configuration)) + + +;;; +;;; XDG user directories. +;;; + +(define (serialize-string field-name val) + ;; The path has to be quoted + (format #f "XDG_~a_DIR=\"~a\"\n" + (object->snake-case-string field-name 'upper) val)) + +(define-configuration home-xdg-user-directories-configuration + (desktop + (string "$HOME/Desktop") + "Default ``desktop'' directory, this is what you see on your +desktop when using a desktop environment, +e.g. GNOME (@pxref{XWindow,,,guix.info}).") + (documents + (string "$HOME/Documents") + "Default directory to put documents like PDFs.") + (download + (string "$HOME/Downloads") + "Default directory downloaded files, this is where your Web-broser +will put downloaded files in.") + (music + (string "$HOME/Music") + "Default directory for audio files.") + (pictures + (string "$HOME/Pictures") + "Default directory for pictures and images.") + (publicshare + (string "$HOME/Public") + "Default directory for shared files, which can be accessed by other +users on local machine or via network.") + (templates + (string "$HOME/Templates") + "Default directory for templates. They can be used by graphical +file manager or other apps for creating new files with some +pre-populated content.") + (videos + (string "$HOME/Videos") + "Default directory for videos.")) + +(define (home-xdg-user-directories-files-service config) + `(("config/user-dirs.conf" + ,(mixed-text-file + "user-dirs.conf" + "enabled=False\n")) + ("config/user-dirs.dirs" + ,(mixed-text-file + "user-dirs.dirs" + (serialize-configuration + config + home-xdg-user-directories-configuration-fields))))) + +(define (home-xdg-user-directories-activation-service config) + (let ((dirs (map (lambda (field) + ((configuration-field-getter field) config)) + home-xdg-user-directories-configuration-fields))) + #~(let ((ensure-dir + (lambda (path) + (mkdir-p + ((@@ (ice-9 string-fun) string-replace-substring) + path "$HOME" (getenv "HOME")))))) + (display "Creating XDG user directories...") + (map ensure-dir '#$dirs) + (display " done\n")))) + +(define home-xdg-user-directories-service-type + (service-type (name 'home-xdg-user-directories) + (extensions + (list (service-extension + home-files-service-type + home-xdg-user-directories-files-service) + (service-extension + home-activation-service-type + home-xdg-user-directories-activation-service))) + (default-value (home-xdg-user-directories-configuration)) + (description "Configure XDG user directories. To +disable a directory, point it to the $HOME."))) + +(define (generate-home-xdg-user-directories-documentation) + (generate-documentation + `((home-xdg-user-directories-configuration + ,home-xdg-user-directories-configuration-fields)) + 'home-xdg-user-directories-configuration)) + + +;;; +;;; XDG MIME applications. +;;; + +;; Example config +;; +;; (home-xdg-mime-applications-configuration +;; (added '((x-scheme-handler/magnet . torrent.desktop))) +;; (default '((inode/directory . file.desktop))) +;; (removed '((inode/directory . thunar.desktop))) +;; (desktop-entries +;; (list (xdg-desktop-entry +;; (file "file") +;; (name "File manager") +;; (type 'application) +;; (config +;; '((exec . "emacsclient -c -a emacs %u")))) +;; (xdg-desktop-entry +;; (file "text") +;; (name "Text editor") +;; (type 'application) +;; (config +;; '((exec . "emacsclient -c -a emacs %u"))) +;; (actions +;; (list (xdg-desktop-action +;; (action 'create) +;; (name "Create an action") +;; (config +;; '((exec . "echo hi")))))))))) + +;; See +;; +;; + +(define (serialize-alist field-name val) + (define (serialize-mimelist-entry key val) + (let ((val (cond + ((list? val) + (string-join (map maybe-object->string val) ";")) + ((or (string? val) (symbol? val)) + val) + (else (raise (formatted-message + (G_ "\ +The value of an XDG MIME entry must be a list, string or symbol, was given ~a") + val)))))) + (format #f "~a=~a\n" key val))) + + (define (merge-duplicates alist acc) + "Merge values that have the same key. + +@example +(merge-duplicates '((key1 . value1) + (key2 . value2) + (key1 . value3) + (key1 . value4)) '()) + +@result{} ((key1 . (value4 value3 value1)) (key2 . value2)) +@end example" + (cond + ((null? alist) acc) + (else (let* ((head (first alist)) + (tail (cdr alist)) + (key (first head)) + (value (cdr head)) + (duplicate? (assoc key acc))) + (if duplicate? + ;; XXX: This will change the order of things, + ;; though, it shouldn't be a problem for XDG MIME. + (merge-duplicates + tail + (alist-cons key + (cons value (maybe-list (cdr duplicate?))) + (alist-delete key acc))) + (merge-duplicates tail (cons head acc))))))) + + (string-append (if (equal? field-name 'default) + "\n[Default Applications]\n" + (format #f "\n[~a Associations]\n" + (string-capitalize (symbol->string field-name)))) + (generic-serialize-alist string-append + serialize-mimelist-entry + (merge-duplicates val '())))) + +(define xdg-desktop-types (make-enumeration + '(application + link + directory))) + +(define (xdg-desktop-type? type) + (unless (enum-set-member? type xdg-desktop-types) + (raise (formatted-message + (G_ "XDG desktop type must be of of ~a, was given: ~a") + (list->human-readable-list (enum-set->list xdg-desktop-types)) + type)))) + +;; TODO: Add proper docs for this +;; XXX: 'define-configuration' require that fields have a default +;; value. +(define-record-type* + xdg-desktop-action make-xdg-desktop-action + xdg-desktop-action? + (action xdg-desktop-action-action) ; symbol + (name xdg-desktop-action-name) ; string + (config xdg-desktop-action-config ; alist + (default '()))) + +(define-record-type* + xdg-desktop-entry make-xdg-desktop-entry + xdg-desktop-entry? + ;; ".desktop" will automatically be added + (file xdg-desktop-entry-file) ; string + (name xdg-desktop-entry-name) ; string + (type xdg-desktop-entry-type) ; xdg-desktop-type + (config xdg-desktop-entry-config ; alist + (default '())) + (actions xdg-desktop-entry-actions ; list of + (default '()))) + +(define desktop-entries? (list-of xdg-desktop-entry?)) +(define (serialize-desktop-entries field-name val) "") + +(define (serialize-xdg-desktop-entry entry) + "Return a tuple of the file name for ENTRY and the serialized +configuration." + (define (format-config key val) + (let ((val (cond + ((list? val) + (string-join (map maybe-object->string val) ";")) + ((boolean? val) + (if val "true" "false")) + (else val))) + (key (string-capitalize (maybe-object->string key)))) + (list (if (string-suffix? key "?") + (string-drop-right key (- (string-length key) 1)) + key) + "=" val "\n"))) + + (define (serialize-alist config) + (generic-serialize-alist identity format-config config)) + + (define (serialize-xdg-desktop-action action) + (match action + (($ action name config) + `(,(format #f "[Desktop Action ~a]\n" + (string-capitalize (maybe-object->string action))) + ,(format #f "Name=~a\n" name) + ,@(serialize-alist config))))) + + (match entry + (($ file name type config actions) + (list (if (string-suffix? file ".desktop") + file + (string-append file ".desktop")) + `("[Desktop Entry]\n" + ,(format #f "Name=~a\n" name) + ,(format #f "Type=~a\n" + (string-capitalize (symbol->string type))) + ,@(serialize-alist config) + ,@(append-map serialize-xdg-desktop-action actions)))))) + +(define-configuration home-xdg-mime-applications-configuration + (added + (alist '()) + "An association list of MIME types and desktop entries which indicate +that the application should used to open the specified MIME type. The +value has to be string, symbol, or list of strings or symbols, this +applies to the `@code{default}', and `@code{removed}' fields as well.") + (default + (alist '()) + "An association list of MIME types and desktop entries which indicate +that the application should be the default for opening the specified +MIME type.") + (removed + (alist '()) + "An association list of MIME types and desktop entries which indicate +that the application cannot open the specified MIME type.") + (desktop-entries + (desktop-entries '()) + "A list of XDG desktop entries to create. See +@code{xdg-desktop-entry}.")) + +(define (home-xdg-mime-applications-files-service config) + (define (add-xdg-desktop-entry-file entry) + (let ((file (first entry)) + (config (second entry))) + (list (format #f "local/share/applications/~a" file) + (apply mixed-text-file + (format #f "xdg-desktop-~a-entry" file) + config)))) + + (append + `(("config/mimeapps.list" + ,(mixed-text-file + "xdg-mime-appplications" + (serialize-configuration + config + home-xdg-mime-applications-configuration-fields)))) + (map (compose add-xdg-desktop-entry-file serialize-xdg-desktop-entry) + (home-xdg-mime-applications-configuration-desktop-entries config)))) + +(define (home-xdg-mime-applications-extension old-config extension-configs) + (define (extract-fields config) + ;; return '(added default removed desktop-entries) + (list (home-xdg-mime-applications-configuration-added config) + (home-xdg-mime-applications-configuration-default config) + (home-xdg-mime-applications-configuration-removed config) + (home-xdg-mime-applications-configuration-desktop-entries config))) + + (define (append-configs elem acc) + (list (append (first elem) (first acc)) + (append (second elem) (second acc)) + (append (third elem) (third acc)) + (append (fourth elem) (fourth acc)))) + + ;; TODO: Implement procedure to check for duplicates without + ;; sacrificing performance. + ;; + ;; Combine all the alists from 'added', 'default' and 'removed' + ;; into one big alist. + (let ((folded-configs (fold append-configs + (extract-fields old-config) + (map extract-fields extension-configs)))) + (home-xdg-mime-applications-configuration + (added (first folded-configs)) + (default (second folded-configs)) + (removed (third folded-configs)) + (desktop-entries (fourth folded-configs))))) + +(define home-xdg-mime-applications-service-type + (service-type (name 'home-xdg-mime-applications) + (extensions + (list (service-extension + home-files-service-type + home-xdg-mime-applications-files-service))) + (compose identity) + (extend home-xdg-mime-applications-extension) + (default-value (home-xdg-mime-applications-configuration)) + (description + "Configure XDG MIME applications, and XDG desktop entries."))) diff --git a/gnu/local.mk b/gnu/local.mk index dc0e732114..8c44c143af 100644 --- a/gnu/local.mk +++ b/gnu/local.mk @@ -77,6 +77,7 @@ GNU_SYSTEM_MODULES = \ %D%/home-services/fontutils.scm \ %D%/home-services/configuration.scm \ %D%/home-services/shells.scm \ + %D%/home-services/xdg.scm \ %D%/image.scm \ %D%/packages.scm \ %D%/packages/abduco.scm \ From patchwork Fri Aug 27 07:07:35 2021 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Andrew Tropin X-Patchwork-Id: 32333 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 86FBB27BBE3; Fri, 27 Aug 2021 08:08:13 +0100 (BST) X-Spam-Checker-Version: SpamAssassin 3.4.2 (2018-09-13) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-2.8 required=5.0 tests=BAYES_00,DKIM_SIGNED, MAILING_LIST_MULTI,RCVD_IN_MSPIKE_H2,SPF_HELO_PASS,T_DKIM_INVALID, URIBL_BLOCKED autolearn=unavailable autolearn_force=no version=3.4.2 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id 01D7227BBE1 for ; Fri, 27 Aug 2021 08:08:13 +0100 (BST) Received: from localhost ([::1]:54408 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1mJVyG-0000Cd-4Z for patchwork@mira.cbaines.net; Fri, 27 Aug 2021 03:08:12 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:51730) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1mJVy6-00008K-V2 for guix-patches@gnu.org; Fri, 27 Aug 2021 03:08:02 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:39630) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1mJVy6-0005kd-NJ for guix-patches@gnu.org; Fri, 27 Aug 2021 03:08:02 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1mJVy6-0005Ab-IV for guix-patches@gnu.org; Fri, 27 Aug 2021 03:08:02 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#50208] [PATCH 5/5] home: Add home-environment. Resent-From: Andrew Tropin Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Fri, 27 Aug 2021 07:08:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 50208 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: Oleg Pykhalov Cc: 50208@debbugs.gnu.org Received: via spool by 50208-submit@debbugs.gnu.org id=B50208.163004806719845 (code B ref 50208); Fri, 27 Aug 2021 07:08:02 +0000 Received: (at 50208) by debbugs.gnu.org; 27 Aug 2021 07:07:47 +0000 Received: from localhost ([127.0.0.1]:51175 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1mJVxq-0005A1-Dh for submit@debbugs.gnu.org; Fri, 27 Aug 2021 03:07:46 -0400 Received: from mail-lj1-f174.google.com ([209.85.208.174]:33431) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1mJVxp-00059o-72 for 50208@debbugs.gnu.org; Fri, 27 Aug 2021 03:07:45 -0400 Received: by mail-lj1-f174.google.com with SMTP id s12so9851407ljg.0 for <50208@debbugs.gnu.org>; Fri, 27 Aug 2021 00:07:45 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=trop-in.20150623.gappssmtp.com; s=20150623; h=from:to:cc:subject:in-reply-to:references:date:message-id :mime-version; bh=LlG0vkpHel4BIBrogJDjIPYyNwcyYajjndC5aD91k7g=; b=JmOIFUWID3xO3XEQAdHawezvDJemOn+ZW2JLSqcyoIRXCPSbCRVV50nhpofl/nlgJ9 JLJ/y3AoMd8ZYwIsFyXjLOQdq4mXVOVrPzx6s4dzy5sp2i3i1sOi4WY3qcau02tFHJ4w ZvShlOKGfKlNSmv6hyE8d7mL5lHX9h2nRn8cJ8jouSKo57irrSpS52JIfI/8rH4O8o+0 HS08m+8xiJWJFsXvxxYjhHxVH1nArQBnlmv1DtPud2jhseamQDkmCe7yRn2QjCUiMWV8 9CXvjIV72yKXZk7BtcffuAPIl20QF/+fqJ4kakUeMPW8sdw3mqJ+Z+otNKVwGprzbz1V bmlQ== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:from:to:cc:subject:in-reply-to:references:date :message-id:mime-version; bh=LlG0vkpHel4BIBrogJDjIPYyNwcyYajjndC5aD91k7g=; b=XQP1/XckIDPszUSLNpu/CnD6X09/wYHSqT42VOfCxbAVgLNT/13RByYdLXxWD+H7c2 ja//z76AaCzAplbrH9zE3THgFm3ljhcN1JBGqLwMYcn40VTWI/1f9cL4LvP+GQb9+K6F O5C/Zdtz4qbyI1zBGWVO5pmlR9ck2wEvm+Y/pNo1K7htfiFd4O2zjP5GJJE8FDhwbg7g P9ufPUS+el6CEbUK78EyYu+xgGvyX7+xXrJItcaQ7+PSxAShf5WuSjAN1J4xmgrvoUhi DHcU/z945clGGzD92snjKTfv5QeFxYFoJHvSVPDEiLZKjC1+kxNDGSFfTG96IJdSJo/K p+Rw== X-Gm-Message-State: AOAM5318Z950G8lYxKmcoINop6x7AKJz1cpa0UoPC+hnqlDv83MuSQJU Z481MWVdCezIwFjAY/Off9GJobxZGbo8Tg== X-Google-Smtp-Source: ABdhPJwH/aNNNuf9tDi1ZPVXXIqAXoak9kk1vXzBcu+oPw+ZHzTDODs81k6cw0x2n3bUxv5Dnu7NHg== X-Received: by 2002:a2e:97cf:: with SMTP id m15mr6367577ljj.125.1630048059129; Fri, 27 Aug 2021 00:07:39 -0700 (PDT) Received: from localhost (109-252-93-92.nat.spd-mgts.ru. [109.252.93.92]) by smtp.gmail.com with ESMTPSA id f30sm509986lfj.219.2021.08.27.00.07.38 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Fri, 27 Aug 2021 00:07:38 -0700 (PDT) From: Andrew Tropin In-Reply-To: <871r6ffklu.fsf@trop.in> References: <87bl5kbsk8.fsf@trop.in> <87r1eg8obm.fsf@gmail.com> <871r6ffklu.fsf@trop.in> Date: Fri, 27 Aug 2021 10:07:35 +0300 Message-ID: <87lf4ne56w.fsf@trop.in> 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" X-getmail-retrieved-from-mailbox: Patches * gnu/home.scm (home-environment, home-environment?, this-home-environment) (home-environment-derivation, home-environment-user-services) (home-environment-essential-services, home-environment-services) (home-environment-location, home-environment-with-provenance): New variables. * gnu/local.mk (GNU_SYSTEM_MODULES): Add home.scm. --- gnu/home.scm | 97 ++++++++++++++++++++++++++++++++++++++++++++++++++++ gnu/local.mk | 1 + 2 files changed, 98 insertions(+) create mode 100644 gnu/home.scm diff --git a/gnu/home.scm b/gnu/home.scm new file mode 100644 index 0000000000..220cc49846 --- /dev/null +++ b/gnu/home.scm @@ -0,0 +1,97 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2021 Andrew Tropin +;;; +;;; 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) + #:use-module (gnu home-services) + #:use-module (gnu home-services symlink-manager) + #:use-module (gnu home-services shells) + #:use-module (gnu home-services xdg) + #:use-module (gnu home-services fontutils) + #:use-module (gnu services) + #:use-module (guix records) + #:use-module (guix diagnostics) + + #:export (home-environment + home-environment? + this-home-environment + + home-environment-derivation + home-environment-user-services + home-environment-essential-services + home-environment-services + home-environment-location + + home-environment-with-provenance)) + +(define-record-type* home-environment + make-home-environment + home-environment? + this-home-environment + + (packages home-environment-packages ; list of (PACKAGE OUTPUT...) + (default '())) + + (essential-services home-environment-essential-services ; list of services + (thunked) + (default (home-environment-default-essential-services + this-home-environment))) + (services home-environment-user-services + (default '())) + + (location home-environment-location ; + (default (and=> (current-source-location) + source-properties->location)) + (innate))) + +(define (home-environment-default-essential-services he) + "Return the list of essential services for home environment." + (list + (service home-run-on-first-login-service-type) + (service home-activation-service-type) + (service home-environment-variables-service-type) + + (service home-symlink-manager-service-type) + + (service home-fontconfig-service-type) + (service home-xdg-base-directories-service-type) + (service home-shell-profile-service-type) + + (service home-service-type) + (service home-profile-service-type (home-environment-packages he)))) + +(define* (home-environment-services he) + "Return all the services of home environment." + (instantiate-missing-services + (append (home-environment-user-services he) + (home-environment-essential-services he)))) + +(define* (home-environment-derivation he) + "Return a derivation that builds OS." + (let* ((services (home-environment-services he)) + (home (fold-services services + #:target-type home-service-type))) + (service-value home))) + +(define* (home-environment-with-provenance he config-file) + "Return a variant of HE that stores its own provenance information, +including CONFIG-FILE, if available. This is achieved by adding an instance +of HOME-PROVENANCE-SERVICE-TYPE to its services." + (home-environment + (inherit he) + (services (cons (service home-provenance-service-type config-file) + (home-environment-user-services he))))) diff --git a/gnu/local.mk b/gnu/local.mk index 8c44c143af..bbaee51140 100644 --- a/gnu/local.mk +++ b/gnu/local.mk @@ -72,6 +72,7 @@ GNU_SYSTEM_MODULES = \ %D%/bootloader/u-boot.scm \ %D%/bootloader/depthcharge.scm \ %D%/ci.scm \ + %D%/home.scm \ %D%/home-services.scm \ %D%/home-services/symlink-manager.scm \ %D%/home-services/fontutils.scm \