From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mp0 ([2001:41d0:2:bcc0::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by ms0.migadu.com with LMTPS id 0jYFNXX5LWElnwAAgWs5BA (envelope-from ) for ; Tue, 31 Aug 2021 11:42:13 +0200 Received: from aspmx1.migadu.com ([2001:41d0:2:bcc0::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by mp0 with LMTPS id mD4DMHX5LWF8eAAA1q6Kng (envelope-from ) for ; Tue, 31 Aug 2021 09:42:13 +0000 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by aspmx1.migadu.com (Postfix) with ESMTPS id 51A04FD80 for ; Tue, 31 Aug 2021 11:42:13 +0200 (CEST) Received: from localhost ([::1]:53614 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1mL0HU-0004RP-CP for larch@yhetil.org; Tue, 31 Aug 2021 05:42:12 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:48036) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1mL0HK-0004Pw-Kw for guix-patches@gnu.org; Tue, 31 Aug 2021 05:42:02 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:49736) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1mL0HK-000399-Cx for guix-patches@gnu.org; Tue, 31 Aug 2021 05:42:02 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1mL0HK-0002LD-BW for guix-patches@gnu.org; Tue, 31 Aug 2021 05:42:02 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#50296] [PATCH 2/2] scripts: home: Add import subcommand. Resent-From: Andrew Tropin Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Tue, 31 Aug 2021 09:42:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 50296 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 50296@debbugs.gnu.org Received: via spool by 50296-submit@debbugs.gnu.org id=B50296.16304028718915 (code B ref 50296); Tue, 31 Aug 2021 09:42:02 +0000 Received: (at 50296) by debbugs.gnu.org; 31 Aug 2021 09:41:11 +0000 Received: from localhost ([127.0.0.1]:33043 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1mL0GV-0002Jd-5O for submit@debbugs.gnu.org; Tue, 31 Aug 2021 05:41:11 -0400 Received: from mail-lf1-f41.google.com ([209.85.167.41]:43964) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1mL0GS-0002JO-Ay for 50296@debbugs.gnu.org; Tue, 31 Aug 2021 05:41:09 -0400 Received: by mail-lf1-f41.google.com with SMTP id m18so23039833lfl.10 for <50296@debbugs.gnu.org>; Tue, 31 Aug 2021 02:41:08 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=trop-in.20150623.gappssmtp.com; s=20150623; h=from:to:subject:in-reply-to:references:date:message-id:mime-version; bh=d9QqO7l7uQhCJWojmGtT0Y22Y+xH6QxS41I9BWfDuPM=; b=BU98cVPhZXrLcsf6+Qbc/TKsxsF8ESMD5ivCblJkTqrxcx17RPFTDLOW13yt1ijZql pHWjweUioSvGU+NjoF9ed4G+IiKgMmgIIMjONciOQEy+VBqGrdXDxcqw115KzlEgy+7R CddpbqyFhNwUpAHm81fpGwppPcr9tydTHOm8TYYNg2UjLyCNWpaMhzKdKR4pVyj/VxeR 7Wrq8U1MZksvby7EQXCcVY3yA5Ri9AOjOrU/QyvUbnp9Lm4Lm2MMbQxcn0BEOSAEO2np 43DigNsyYkhgv/M/ZTWKCRPLj/EEZkD9JWv8Oo/36knjhTnTe6aMSyEidp/vH5gu8gxF qCYg== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:from:to:subject:in-reply-to:references:date :message-id:mime-version; bh=d9QqO7l7uQhCJWojmGtT0Y22Y+xH6QxS41I9BWfDuPM=; b=FeYmqHrfAx81pue3Mxd3KLaBEN09nuChd4HR9PwHfGBRgyGKWYcbU3Hg/E1lna3eC5 yMZrOJPGmNHzbzukHkrdhtmjliHtZBToxdrPyH2XgdJAtmFJ5OdrO6oGjMZ/VUb5SnXq D7MQV2kiNd0+DGG1egkJ/ReNVnrKtVFGDJdfwPWzZ3kZA/kg9UFboqR9DlKs7+M1Xoc4 MsCz9a4gYxjh4+pk4fLl4ydKXje5S5J+ivjEk8oXtEqlAzx9QJwjZHsZRQfWdJhwriaw 7jCoOCu0jHcUOJ1BKRe6dQALFKsbGB0OUnkmyryivKzZVhS3bcaWBAJ0rJbRQwnR2gUs 30nw== X-Gm-Message-State: AOAM532CcuPk4d8e0f9o6yDuVqgCMy8FfGWNFUuRMfqrvtiwmD038A/L BK/OhSAMao9sLvYD4OjcPZxJNhdPBdIeMw== X-Google-Smtp-Source: ABdhPJzPM7QZNAmf5gYtQ7biYjcRhOVdXNN3ww+MGr8OBDfCjY9/wcvu0q35RkSA/k8m9tCCV83cGA== X-Received: by 2002:a05:6512:11ec:: with SMTP id p12mr20613626lfs.379.1630402861788; Tue, 31 Aug 2021 02:41:01 -0700 (PDT) Received: from localhost (109-252-93-92.nat.spd-mgts.ru. [109.252.93.92]) by smtp.gmail.com with ESMTPSA id w2sm1312226lfq.20.2021.08.31.02.41.00 for <50296@debbugs.gnu.org> (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Tue, 31 Aug 2021 02:41:01 -0700 (PDT) From: Andrew Tropin In-Reply-To: References: <874kb6j718.fsf@trop.in> Date: Tue, 31 Aug 2021 12:40:58 +0300 Message-ID: <87v93mhryt.fsf@trop.in> MIME-Version: 1.0 Content-Type: multipart/signed; boundary="=-=-="; micalg=pgp-sha512; protocol="application/pgp-signature" 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+larch=yhetil.org@gnu.org Sender: "Guix-patches" X-Migadu-Flow: FLOW_IN ARC-Message-Signature: i=1; a=rsa-sha256; c=relaxed/relaxed; d=yhetil.org; s=key1; t=1630402933; h=from:from:sender:sender:reply-to:subject:subject:date:date: message-id:message-id:to:to:cc:mime-version:mime-version: content-type:content-type:resent-cc:resent-from:resent-sender: resent-message-id:in-reply-to:in-reply-to:references:references: list-id:list-help:list-unsubscribe:list-subscribe:list-post: dkim-signature; bh=d9QqO7l7uQhCJWojmGtT0Y22Y+xH6QxS41I9BWfDuPM=; b=j+zzOX+TT+zF9Ng1BYbKg0G5FKAF+hcrA0eZAbaMu1zTHDWn2Wr9TwPVk2aZqoA7Ywr84I rgSuG1qi5DzExNOiRtx89vxDrqimKDkFKSH6pTnjlvzXjCK967jU4/rvL8QlCPvw0TjO6e qlMRje/zlU3jQFmJPNNJ29iGYqfmu1JJhUdPqUbv0fVloFcsAfQka5uYYeHFt1Q0jnbnwC t/WToy/wOVdf3/isLFj+dFNuvbgKVRMxV3951VqMo4LEUJP5fqZAJirkMwLHxlwb5n2RQ/ ik7rv3G1Rt1Db59uPpf85y0JLtP1hng4fbnkXFDJDJvLWbtPQXgmldm++XOd+A== ARC-Seal: i=1; s=key1; d=yhetil.org; t=1630402933; a=rsa-sha256; cv=none; b=ZTiLd4ziAmZEKaxAnNetmEyYAR3pLadW//MVhliJa08Bs8P2UCfAUOiYLzYa9aaGwU2TeZ sHMNVEq60V0r+N4rEE+s2m+w6cgTNd0TV2MkvLB/aXu3bkvYtrLwOi6TXwM+TwmhtI286x 5zqBgbmz9as2fS1Ugn9ZfwpfgDz+vtlxD2o3kRZ2FtbKRntyr7LAJNYzGkeHdPD4y7O2B8 iEEaY/ofoWtu+Vvpumx+/DXmG3UtLdW+LpibgeDzCUkinD3Ykx1oXlTp7SKaXe0evIkWri uqilE9qXtuEO4arH9nR3TpiCBqKMGODAxJIJdcMhvpp542Nz6m/dQZJX8+Dmbg== ARC-Authentication-Results: i=1; aspmx1.migadu.com; dkim=fail ("headers rsa verify failed") header.d=trop-in.20150623.gappssmtp.com header.s=20150623 header.b=BU98cVPh; spf=pass (aspmx1.migadu.com: domain of guix-patches-bounces@gnu.org designates 209.51.188.17 as permitted sender) smtp.mailfrom=guix-patches-bounces@gnu.org X-Migadu-Spam-Score: -3.52 Authentication-Results: aspmx1.migadu.com; dkim=fail ("headers rsa verify failed") header.d=trop-in.20150623.gappssmtp.com header.s=20150623 header.b=BU98cVPh; dmarc=none; spf=pass (aspmx1.migadu.com: domain of guix-patches-bounces@gnu.org designates 209.51.188.17 as permitted sender) smtp.mailfrom=guix-patches-bounces@gnu.org X-Migadu-Queue-Id: 51A04FD80 X-Spam-Score: -3.52 X-Migadu-Scanner: scn0.migadu.com X-TUID: eyKFBLfzpDqP --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable * guix/scripts/home/import.scm: New file. * Makefile.am (MODULES): Add it. =2D-- Makefile.am | 1 + guix/scripts/home.scm | 2 +- guix/scripts/home/import.scm | 241 +++++++++++++++++++++++++++++++++++ 3 files changed, 243 insertions(+), 1 deletion(-) create mode 100644 guix/scripts/home/import.scm diff --git a/Makefile.am b/Makefile.am index d44360c034..c27dcf9a38 100644 =2D-- a/Makefile.am +++ b/Makefile.am @@ -296,6 +296,7 @@ MODULES =3D \ guix/scripts/system/search.scm \ guix/scripts/system/reconfigure.scm \ guix/scripts/home.scm \ + guix/scripts/home/import.scm \ guix/scripts/lint.scm \ guix/scripts/challenge.scm \ guix/scripts/import/crate.scm \ diff --git a/guix/scripts/home.scm b/guix/scripts/home.scm index 9eb5c0c917..75df6d707d 100644 =2D-- a/guix/scripts/home.scm +++ b/guix/scripts/home.scm @@ -36,7 +36,7 @@ #:use-module (guix scripts build) #:use-module (guix scripts system search) #:autoload (guix scripts pull) (channel-commit-hyperlink) =2D ;; #:use-module (guix scripts home import) + #:use-module (guix scripts home import) #:use-module ((guix status) #:select (with-status-verbosity)) #:use-module (guix gexp) #:use-module (guix monads) diff --git a/guix/scripts/home/import.scm b/guix/scripts/home/import.scm new file mode 100644 index 0000000000..39f45dbeac =2D-- /dev/null +++ b/guix/scripts/home/import.scm @@ -0,0 +1,241 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright =C2=A9 2021 Xinglu Chen +;;; Copyright =C2=A9 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 (guix scripts home import) + #:use-module (guix profiles) + #:use-module (guix ui) + #:use-module (ice-9 match) + #:use-module (ice-9 pretty-print) + #:use-module (srfi srfi-1) + #:export (import-manifest)) + +;;; Commentary: +;;; +;;; This module provides utilities for generating home service +;;; configurations from existing "dotfiles". +;;; +;;; Code: + + +(define (generate-bash-module+configuration) + (let ((rc (string-append (getenv "HOME") "/.bashrc")) + (profile (string-append (getenv "HOME") "/.bash_profile")) + (logout (string-append (getenv "HOME") "/.bash_logout"))) + `((gnu home-services bash) + (service home-bash-service-type + (home-bash-configuration + ,@(if (file-exists? rc) + `((bashrc + (list (slurp-file-gexp (local-file ,rc))))) + '()) + ,@(if (file-exists? profile) + `((bash-profile + (list (slurp-file-gexp + (local-file ,profile))))) + '()) + ,@(if (file-exists? logout) + `((bash-logout + (list (slurp-file-gexp + (local-file ,logout))))) + '())))))) + + +(define %files-configurations-alist + `((".bashrc" . ,generate-bash-module+configuration) + (".bash_profile" . ,generate-bash-module+configuration) + (".bash_logout" . ,generate-bash-module+configuration))) + +(define (modules+configurations) + (let ((configurations (delete-duplicates + (filter-map (match-lambda + ((file . proc) + (if (file-exists? + (string-append (getenv "HOME") "/" f= ile)) + proc + #f))) + %files-configurations-alist) + (lambda (x y) + (equal? (procedure-name x) (procedure-name y)))= ))) + (map (lambda (proc) (proc)) configurations))) + +;; Based on `manifest->code' from (guix profiles) +;; MAYBE: Upstream it? +(define* (manifest->code manifest + #:key + (entry-package-version (const "")) + (home-environment? #f)) + "Return an sexp representing code to build an approximate version of +MANIFEST; the code is wrapped in a top-level 'begin' form. If +HOME-ENVIRONMENT? is #t, return an definition. +Call ENTRY-PACKAGE-VERSION to determine the version number to use in +the spec for a given entry; it can be set to 'manifest-entry-version' +for fully-specified version numbers, or to some other procedure to +disambiguate versions for packages for which several versions are +available." + (define (entry-transformations entry) + ;; Return the transformations that apply to ENTRY. + (assoc-ref (manifest-entry-properties entry) 'transformations)) + + (define transformation-procedures + ;; List of transformation options/procedure name pairs. + (let loop ((entries (manifest-entries manifest)) + (counter 1) + (result '())) + (match entries + (() result) + ((entry . tail) + (match (entry-transformations entry) + (#f + (loop tail counter result)) + (options + (if (assoc-ref result options) + (loop tail counter result) + (loop tail (+ 1 counter) + (alist-cons options + (string->symbol + (format #f "transform~a" counter)) + result))))))))) + + (define (qualified-name entry) + ;; Return the name of ENTRY possibly with "@" followed by a version. + (match (entry-package-version entry) + ("" (manifest-entry-name entry)) + (version (string-append (manifest-entry-name entry) + "@" version)))) + + (if (null? transformation-procedures) + (let ((specs (map (lambda (entry) + (match (manifest-entry-output entry) + ("out" (qualified-name entry)) + (output (string-append (qualified-name entry) + ":" output)))) + (manifest-entries manifest)))) + (if home-environment? + (let ((modules+configurations (modules+configurations))) + `(begin + (use-modules (gnu home) + (gnu packages) + ,@(map first modules+configurations)) + ,(home-environment-template + #:specs specs + #:services (map second modules+configurations)))) + `(begin + (use-modules (gnu packages)) + + (specifications->manifest + (list ,@specs))))) + (let* ((transform (lambda (options exp) + (if (not options) + exp + (let ((proc (assoc-ref transformation-procedu= res + options))) + `(,proc ,exp))))) + (packages (map (lambda (entry) + (define options + (entry-transformations entry)) + + (define name + (qualified-name entry)) + + (match (manifest-entry-output entry) + ("out" + (transform options + `(specification->package = ,name))) + (output + `(list ,(transform + options + `(specification->package ,n= ame)) + ,output)))) + (manifest-entries manifest))) + (transformations (map (match-lambda + ((options . name) + `(define ,name + (options->transformation ',options)))) + transformation-procedures))) + (if home-environment? + (let ((modules+configurations (modules+configurations))) + `(begin + (use-modules (guix transformations) + (gnu home) + (gnu packages) + ,@(map first modules+configurations)) + + ,@transformations + + ,(home-environment-template + #:packages packages + #:services (map second modules+configurations)))) + `(begin + (use-modules (guix transformations) + (gnu packages)) + + ,@transformations + + (packages->manifest + (list ,@packages))))))) + +(define* (home-environment-template #:key (packages #f) (specs #f) service= s) + "Return an S-exp containing a declaration +containing PACKAGES, or SPECS (package specifications), and SERVICES." + `(home-environment + (packages + ,@(if packages + `((list ,@packages)) + `((map specification->package + (list ,@specs))))) + (services (list ,@services)))) + +(define* (import-manifest + manifest + #:optional (port (current-output-port))) + "Write to PORT a corresponding to MANIFEST." + (define (version-spec entry) + (let ((name (manifest-entry-name entry))) + (match (map package-version (find-packages-by-name name)) + ((_) + ;; A single version of NAME is available, so do not specify the + ;; version number, even if the available version doesn't match EN= TRY. + "") + (versions + ;; If ENTRY uses the latest version, don't specify any version. + ;; Otherwise return the shortest unique version prefix. Note that + ;; this is based on the currently available packages, which could + ;; differ from the packages available in the revision that was us= ed + ;; to build MANIFEST. + (let ((current (manifest-entry-version entry))) + (if (every (cut version>? current <>) + (delete current versions)) + "" + (version-unique-prefix (manifest-entry-version entry) + versions))))))) + + (match (manifest->code manifest + #:entry-package-version version-spec + #:home-environment? #t) + (('begin exp ...) + (format port (G_ "\ +;; This \"home-environment\" file can be passed to 'guix home reconfigure' +;; to reproduce the content of your profile. This is \"symbolic\": it only +;; specifies package names. To reproduce the exact same profile, you also +;; need to capture the channels being used, as returned by \"guix describe= \". +;; See the \"Replicating Guix\" section in the manual.\n")) + (for-each (lambda (exp) + (newline port) + (pretty-print exp port)) + exp)))) =2D-=20 2.33.0 --=-=-= Content-Type: application/pgp-signature; name="signature.asc" -----BEGIN PGP SIGNATURE----- iQIzBAEBCgAdFiEEKEGaxlA4dEDH6S/6IgjSCVjB3rAFAmEt+SoACgkQIgjSCVjB 3rD7hw/7By/FO3SarrQZ0kmMNWV83UIi2ztywbNAayzHmSsT1cLIi/xKaKOT+05W 3SVDdg8VZRR6C3Wc7RIujPnCqO5iWGtVHOTbmgNEfS8JPSlxqA3yHkkmxuvltbI/ DNwUPgiYx2rqb2EaTNLAgu+Dsyb9K4RN6j+GAXuDRAmcy3ttk7h7kx2wxcwT16Jo CEi2SNlIxCfUfEfvNMa7mzQ46LlC+cdsq78SnFcfioL3keWhHFsoSjPHp4K+ZEN0 9fLzi4NLq0nTkyuXCG/wW0TUNBBr1zw5ZOpGfKejGzoH2JGn7ufuc4IDeULkgDiS 8pJhBKtKSBKyVLo2Nk6xhcnOiu/88O8XebHcmqS10Jijpt6zaJof4ONhY9nYBhV7 w5iqUxEaANbQ1GG3mtcB5AZJloPpIIG5UEgAdjE4bBVoEot2HIrZ9P0r4DQk9hqm 7L9iZDU6WW6C0gPhvnWx7YXqZG8gBofbEo76GMLMgGARJT/6SPaEz4q6dFobgRRd 4F2utWajCAFAHjdv9UHTFS6F2PwjQ05uLH8E7uOywvOCu0kmyBCyt6n1bNmes7h4 NXP6y5NR931XGpJselSOeQABHYUaR1H2ODTcxQbJvERFLltJ15CgxhCt6Zjh3z72 n34GI19YJsgAyFNnm2aRsYGe4Uw+LB4eTAAxvyDSSX1INrwqEHw= =JFMU -----END PGP SIGNATURE----- --=-=-=--