From patchwork Tue Feb 28 15:47:01 2023 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Christopher Baines X-Patchwork-Id: 47488 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 919B716C22; Tue, 28 Feb 2023 15:48:44 +0000 (GMT) X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-2.0 required=5.0 tests=MAILING_LIST_MULTI, RCVD_IN_MSPIKE_H2,SPF_HELO_PASS autolearn=unavailable autolearn_force=no version=3.4.6 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id D833C16BBF for ; Tue, 28 Feb 2023 15:48:43 +0000 (GMT) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1pX2DE-0008JD-Et; Tue, 28 Feb 2023 10:48:20 -0500 Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1pX2D7-00081F-3u for guix-patches@gnu.org; Tue, 28 Feb 2023 10:48:14 -0500 Received: from debbugs.gnu.org ([209.51.188.43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1pX2Cv-0004bq-Vh for guix-patches@gnu.org; Tue, 28 Feb 2023 10:48:11 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1pX2Cv-0003rE-RN for guix-patches@gnu.org; Tue, 28 Feb 2023 10:48:01 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#61363] [PATCH v2 1/3] packages: Export guile-for-grafts. References: <871qn08uo7.fsf@cbaines.net> In-Reply-To: <871qn08uo7.fsf@cbaines.net> Resent-From: Christopher Baines Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Tue, 28 Feb 2023 15:48:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 61363 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 61363@debbugs.gnu.org Received: via spool by 61363-submit@debbugs.gnu.org id=B61363.167759922714625 (code B ref 61363); Tue, 28 Feb 2023 15:48:01 +0000 Received: (at 61363) by debbugs.gnu.org; 28 Feb 2023 15:47:07 +0000 Received: from localhost ([127.0.0.1]:51792 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1pX2C3-0003no-HP for submit@debbugs.gnu.org; Tue, 28 Feb 2023 10:47:07 -0500 Received: from mira.cbaines.net ([212.71.252.8]:42290) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1pX2C1-0003nS-O2 for 61363@debbugs.gnu.org; Tue, 28 Feb 2023 10:47:06 -0500 Received: from localhost (unknown [IPv6:2a02:8010:68c1:0:54d1:d5d4:280e:f699]) by mira.cbaines.net (Postfix) with ESMTPSA id 4F77E16BBA for <61363@debbugs.gnu.org>; Tue, 28 Feb 2023 15:47:04 +0000 (GMT) Received: from localhost (localhost [local]) by localhost (OpenSMTPD) with ESMTPA id cb7815f2 for <61363@debbugs.gnu.org>; Tue, 28 Feb 2023 15:47:03 +0000 (UTC) From: Christopher Baines Date: Tue, 28 Feb 2023 15:47:01 +0000 Message-Id: <20230228154703.3952-1-mail@cbaines.net> X-Mailer: git-send-email 2.39.1 MIME-Version: 1.0 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org X-getmail-retrieved-from-mailbox: Patches So this can be used in (guix self). * guix/packages.scm (guile-for-grafts): Export. --- guix/packages.scm | 1 + 1 file changed, 1 insertion(+) diff --git a/guix/packages.scm b/guix/packages.scm index 041a872f9d..2f81ad0284 100644 --- a/guix/packages.scm +++ b/guix/packages.scm @@ -183,6 +183,7 @@ (define-module (guix packages) package-closure default-guile + guile-for-grafts default-guile-derivation set-guile-for-build package-file From patchwork Tue Feb 28 15:47:02 2023 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Christopher Baines X-Patchwork-Id: 47489 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 2F44A16C22; Tue, 28 Feb 2023 15:49:07 +0000 (GMT) X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-2.0 required=5.0 tests=MAILING_LIST_MULTI, RCVD_IN_MSPIKE_H2,SPF_HELO_PASS autolearn=unavailable autolearn_force=no version=3.4.6 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id CF85916BBF for ; Tue, 28 Feb 2023 15:49:05 +0000 (GMT) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1pX2DM-0008SB-2t; Tue, 28 Feb 2023 10:48:28 -0500 Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1pX2D7-00081G-41 for guix-patches@gnu.org; Tue, 28 Feb 2023 10:48:14 -0500 Received: from debbugs.gnu.org ([209.51.188.43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1pX2Cw-0004bt-BB for guix-patches@gnu.org; Tue, 28 Feb 2023 10:48:11 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1pX2Cw-0003rN-6b for guix-patches@gnu.org; Tue, 28 Feb 2023 10:48:02 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#61363] [PATCH v2 2/3] self: Restructure accessing packages. Resent-From: Christopher Baines Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Tue, 28 Feb 2023 15:48:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 61363 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 61363@debbugs.gnu.org Received: via spool by 61363-submit@debbugs.gnu.org id=B61363.167759922814632 (code B ref 61363); Tue, 28 Feb 2023 15:48:02 +0000 Received: (at 61363) by debbugs.gnu.org; 28 Feb 2023 15:47:08 +0000 Received: from localhost ([127.0.0.1]:51794 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1pX2C3-0003nq-PM for submit@debbugs.gnu.org; Tue, 28 Feb 2023 10:47:08 -0500 Received: from mira.cbaines.net ([212.71.252.8]:42288) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1pX2C1-0003nQ-Oj for 61363@debbugs.gnu.org; Tue, 28 Feb 2023 10:47:06 -0500 Received: from localhost (unknown [IPv6:2a02:8010:68c1:0:54d1:d5d4:280e:f699]) by mira.cbaines.net (Postfix) with ESMTPSA id 645EC16BBF for <61363@debbugs.gnu.org>; Tue, 28 Feb 2023 15:47:04 +0000 (GMT) Received: from localhost (localhost [local]) by localhost (OpenSMTPD) with ESMTPA id 667d7896 for <61363@debbugs.gnu.org>; Tue, 28 Feb 2023 15:47:03 +0000 (UTC) From: Christopher Baines Date: Tue, 28 Feb 2023 15:47:02 +0000 Message-Id: <20230228154703.3952-2-mail@cbaines.net> X-Mailer: git-send-email 2.39.1 In-Reply-To: <20230228154703.3952-1-mail@cbaines.net> References: <20230228154703.3952-1-mail@cbaines.net> MIME-Version: 1.0 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org X-getmail-retrieved-from-mailbox: Patches Both for consistency (always use specification->package as defined in this module) and so that all the packages that are used can be accessed (which comes in useful when applying grafts). * guix/self.scm (%packages): New variable. (specification->package): Use %packages. (locale-data, translate-texi-manuals, info-manual, guix-command, compiled-guix): Use specification->package. --- guix/self.scm | 97 +++++++++++++++++++++++++-------------------------- 1 file changed, 48 insertions(+), 49 deletions(-) diff --git a/guix/self.scm b/guix/self.scm index 93019e1c64..c5de3ab8fc 100644 --- a/guix/self.scm +++ b/guix/self.scm @@ -44,34 +44,42 @@ (define-module (guix self) ;;; Dependency handling. ;;; -(define specification->package +(define %packages + (let ((ref (lambda (module variable) + (delay + (module-ref (resolve-interface + `(gnu packages ,module)) + variable))))) + `(("guile" . ,(ref 'guile 'guile-3.0-latest)) + ("guile-avahi" . ,(ref 'guile-xyz 'guile-avahi)) + ("guile-json" . ,(ref 'guile 'guile-json-4)) + ("guile-ssh" . ,(ref 'ssh 'guile-ssh)) + ("guile-git" . ,(ref 'guile 'guile-git)) + ("guile-semver" . ,(ref 'guile-xyz 'guile-semver)) + ("guile-lib" . ,(ref 'guile-xyz 'guile-lib)) + ("guile-sqlite3" . ,(ref 'guile 'guile-sqlite3)) + ("guile-zlib" . ,(ref 'guile 'guile-zlib)) + ("guile-lzlib" . ,(ref 'guile 'guile-lzlib)) + ("guile-zstd" . ,(ref 'guile 'guile-zstd)) + ("guile-gcrypt" . ,(ref 'gnupg 'guile-gcrypt)) + ("guile-gnutls" . ,(ref 'tls 'guile-gnutls)) + ("guix-daemon" . ,(ref 'package-management 'guix-daemon)) + ("disarchive" . ,(ref 'backup 'disarchive)) + ("guile-lzma" . ,(ref 'guile 'guile-lzma)) + ("gzip" . ,(ref 'compression 'gzip)) + ("bzip2" . ,(ref 'compression 'bzip2)) + ("xz" . ,(ref 'compression 'xz)) + ("po4a" . ,(ref 'gettext 'po4a)) + ("gettext-minimal" . ,(ref 'gettext 'gettext-minimal)) + ("gcc-toolchain" . ,(ref 'commencement 'gcc-toolchain)) + ("glibc-utf8-locales" . ,(ref 'base 'glibc-utf8-locales)) + ("graphviz" . ,(ref 'graphviz 'graphviz)) + ("texinfo" . ,(ref 'texinfo 'texinfo))))) + +(define (specification->package name) ;; Use our own variant of that procedure because that of (gnu packages) ;; would traverse all the .scm files, which is wasteful. - (let ((ref (lambda (module variable) - (module-ref (resolve-interface module) variable)))) - (match-lambda - ("guile" (ref '(gnu packages guile) 'guile-3.0-latest)) - ("guile-avahi" (ref '(gnu packages guile-xyz) 'guile-avahi)) - ("guile-json" (ref '(gnu packages guile) 'guile-json-4)) - ("guile-ssh" (ref '(gnu packages ssh) 'guile-ssh)) - ("guile-git" (ref '(gnu packages guile) 'guile-git)) - ("guile-semver" (ref '(gnu packages guile-xyz) 'guile-semver)) - ("guile-lib" (ref '(gnu packages guile-xyz) 'guile-lib)) - ("guile-sqlite3" (ref '(gnu packages guile) 'guile-sqlite3)) - ("guile-zlib" (ref '(gnu packages guile) 'guile-zlib)) - ("guile-lzlib" (ref '(gnu packages guile) 'guile-lzlib)) - ("guile-zstd" (ref '(gnu packages guile) 'guile-zstd)) - ("guile-gcrypt" (ref '(gnu packages gnupg) 'guile-gcrypt)) - ("guile-gnutls" (ref '(gnu packages tls) 'guile-gnutls)) - ("disarchive" (ref '(gnu packages backup) 'disarchive)) - ("guile-lzma" (ref '(gnu packages guile) 'guile-lzma)) - ("gzip" (ref '(gnu packages compression) 'gzip)) - ("bzip2" (ref '(gnu packages compression) 'bzip2)) - ("xz" (ref '(gnu packages compression) 'xz)) - ("po4a" (ref '(gnu packages gettext) 'po4a)) - ("gettext" (ref '(gnu packages gettext) 'gettext-minimal)) - ("gcc-toolchain" (ref '(gnu packages commencement) 'gcc-toolchain)) - (_ #f)))) ;no such package + (and=> (assoc-ref %packages name) force)) ;;; @@ -240,9 +248,8 @@ (define* (locale-data source domain #:optional (directory domain)) "Return the locale data from 'po/DIRECTORY' in SOURCE, corresponding to DOMAIN, a gettext domain." - (define gettext - (module-ref (resolve-interface '(gnu packages gettext)) - 'gettext-minimal)) + (define gettext-minimal + (specification->package "gettext-minimal")) (define build (with-imported-modules '((guix build utils)) @@ -258,7 +265,7 @@ (define (compile language) (let ((gmo (string-append #$output "/" language "/LC_MESSAGES/" #$domain ".mo"))) (mkdir-p (dirname gmo)) - (invoke #+(file-append gettext "/bin/msgfmt") + (invoke #+(file-append gettext-minimal "/bin/msgfmt") "-c" "--statistics" "--verbose" "-o" gmo (string-append po-directory "/" language ".po")))) @@ -280,20 +287,19 @@ (define (translate-texi-manuals source) "Return the translated texinfo manuals built from SOURCE." (define po4a (specification->package "po4a")) - - (define gettext - (specification->package "gettext")) + + (define gettext-minimal + (specification->package "gettext-minimal")) (define glibc-utf8-locales - (module-ref (resolve-interface '(gnu packages base)) - 'glibc-utf8-locales)) + (specification->package "glibc-utf8-locales")) (define documentation (file-append* source "doc")) (define documentation-po (file-append* source "po/doc")) - + (define build (with-imported-modules '((guix build utils) (guix build po)) #~(begin @@ -365,7 +371,7 @@ (define parallel-jobs (setenv "GUIX_LOCPATH" #+(file-append glibc-utf8-locales "/lib/locale")) - (setenv "PATH" #+(file-append gettext "/bin")) + (setenv "PATH" #+(file-append gettext-minimal "/bin")) (setenv "LC_ALL" "en_US.UTF-8") (setlocale LC_ALL "en_US.UTF-8") @@ -394,16 +400,13 @@ (define parallel-jobs (define (info-manual source) "Return the Info manual built from SOURCE." (define texinfo - (module-ref (resolve-interface '(gnu packages texinfo)) - 'texinfo)) + (specification->package "texinfo")) (define graphviz - (module-ref (resolve-interface '(gnu packages graphviz)) - 'graphviz)) + (specification->package "graphviz")) (define glibc-utf8-locales - (module-ref (resolve-interface '(gnu packages base)) - 'glibc-utf8-locales)) + (specification->package "glibc-utf8-locales")) (define documentation (file-append* source "doc")) @@ -586,8 +589,7 @@ (define* (guix-command modules "Return the 'guix' command such that it adds MODULES and DEPENDENCIES in its load path." (define glibc-utf8-locales - (module-ref (resolve-interface '(gnu packages base)) - 'glibc-utf8-locales)) + (specification->package "glibc-utf8-locales")) (define module-directory ;; To minimize the number of 'stat' calls needed to locate a module, @@ -1030,10 +1032,7 @@ (define (built-modules node-subset) ;; Include 'guix-daemon'. XXX: Here we inject an ;; older snapshot of guix-daemon, but that's a good ;; enough approximation for now. - #:daemon (module-ref (resolve-interface - '(gnu packages - package-management)) - 'guix-daemon) + #:daemon (specification->package "guix-daemon") #:info (info-manual source) #:miscellany (miscellaneous-files source) From patchwork Tue Feb 28 15:47:03 2023 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Christopher Baines X-Patchwork-Id: 47490 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 3B84B16C38; Tue, 28 Feb 2023 15:49:16 +0000 (GMT) X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-2.0 required=5.0 tests=MAILING_LIST_MULTI, RCVD_IN_MSPIKE_H2,SPF_HELO_PASS autolearn=ham autolearn_force=no version=3.4.6 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id 9743C16BBA for ; Tue, 28 Feb 2023 15:49:13 +0000 (GMT) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1pX2DM-00004r-B1; Tue, 28 Feb 2023 10:48:28 -0500 Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1pX2D7-00081H-5x for guix-patches@gnu.org; Tue, 28 Feb 2023 10:48:14 -0500 Received: from debbugs.gnu.org ([209.51.188.43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1pX2Cw-0004by-Mn for guix-patches@gnu.org; Tue, 28 Feb 2023 10:48:11 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1pX2Cw-0003rW-IC for guix-patches@gnu.org; Tue, 28 Feb 2023 10:48:02 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#61363] [PATCH v2 3/3] self: Apply grafts to the outputs of the guix derivation. Resent-From: Christopher Baines Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Tue, 28 Feb 2023 15:48:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 61363 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 61363@debbugs.gnu.org Received: via spool by 61363-submit@debbugs.gnu.org id=B61363.167759923514649 (code B ref 61363); Tue, 28 Feb 2023 15:48:02 +0000 Received: (at 61363) by debbugs.gnu.org; 28 Feb 2023 15:47:15 +0000 Received: from localhost ([127.0.0.1]:51796 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1pX2CA-0003oC-Cx for submit@debbugs.gnu.org; Tue, 28 Feb 2023 10:47:14 -0500 Received: from mira.cbaines.net ([212.71.252.8]:42292) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1pX2C1-0003nR-PG for 61363@debbugs.gnu.org; Tue, 28 Feb 2023 10:47:06 -0500 Received: from localhost (unknown [IPv6:2a02:8010:68c1:0:54d1:d5d4:280e:f699]) by mira.cbaines.net (Postfix) with ESMTPSA id 6EAB916C22 for <61363@debbugs.gnu.org>; Tue, 28 Feb 2023 15:47:04 +0000 (GMT) Received: from localhost (localhost [local]) by localhost (OpenSMTPD) with ESMTPA id 11115824 for <61363@debbugs.gnu.org>; Tue, 28 Feb 2023 15:47:03 +0000 (UTC) From: Christopher Baines Date: Tue, 28 Feb 2023 15:47:03 +0000 Message-Id: <20230228154703.3952-3-mail@cbaines.net> X-Mailer: git-send-email 2.39.1 In-Reply-To: <20230228154703.3952-1-mail@cbaines.net> References: <20230228154703.3952-1-mail@cbaines.net> MIME-Version: 1.0 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org X-getmail-retrieved-from-mailbox: Patches Rather than having grafts apply to the derivation itself. This moves grafting here to work like grafting for packages, where you can think of the grafted outputs as a transformed variant of the ungrafted outputs. I'm looking at this as it'll allow the Guix Data Service to compute the derivations without grafts, and for these to be useful for substitutes regardless of whether users are using grafts. * guix/self.scm (compiled-guix, guix-derivation): Add a #:graft? keyword argument, to control grafting when computing the guix derivation. * build-aux/build-self.scm (build-program): Call guix-derivation with #:graft? (%graft?) to make the compute-guix-derivation script use or not use grafts as desired. --- build-aux/build-self.scm | 4 +- guix/self.scm | 101 +++++++++++++++++++++++++++++++-------- 2 files changed, 84 insertions(+), 21 deletions(-) diff --git a/build-aux/build-self.scm b/build-aux/build-self.scm index 02822a2ee8..6d0037f20c 100644 --- a/build-aux/build-self.scm +++ b/build-aux/build-self.scm @@ -353,7 +353,9 @@ (define fake-git #:channel-metadata '#$channel-metadata #:pull-version - #$pull-version) + #$pull-version + #:graft? + #$(%graft?)) #:system system)) derivation-file-name)))))) #:module-path (list source)))) diff --git a/guix/self.scm b/guix/self.scm index c5de3ab8fc..8842275ff8 100644 --- a/guix/self.scm +++ b/guix/self.scm @@ -22,6 +22,7 @@ (define-module (guix self) #:use-module (guix i18n) #:use-module (guix modules) #:use-module (guix gexp) + #:use-module (guix grafts) #:use-module (guix store) #:use-module (guix monads) #:use-module (guix discovery) @@ -32,6 +33,7 @@ (define-module (guix self) #:use-module ((guix build utils) #:select (find-files)) #:use-module (srfi srfi-1) #:use-module (srfi srfi-9) + #:use-module (srfi srfi-9 gnu) #:use-module (srfi srfi-35) #:use-module (ice-9 match) #:export (make-config.scm @@ -244,6 +246,50 @@ (define* (file-append* item file #:key (recursive? #t)) ;; which isn't great. (file-append item "/" file)))) +(define graft-derivation* + (store-lift graft-derivation)) + +(define package-grafts* + (store-lift package-grafts)) + +;; Apply grafts explicitly +(define-immutable-record-type + (%explicit-grafting obj packages) + explicit-grafting? + (obj explicit-grafting-obj) ;obj + (packages explicit-grafting-packages)) ;list of s + +(define (write-explicit-grafting rec port) + (match rec + (($ obj packages) + (format port "#" obj packages)))) + +(define (explicit-grafting obj packages) + (%explicit-grafting obj packages)) + +(define-gexp-compiler (explicit-grafting-compiler (explicit-grafting ) + system target) + (match explicit-grafting + (($ obj packages) + (mlet* %store-monad ((drv (without-grafting + (lower-object obj system #:target target))) + (grafts + (mapm %store-monad + (lambda (pkg) + (package-grafts* pkg system #:target target)) + packages))) + (match (delete-duplicates + (concatenate grafts)) + (() + (return drv)) + (grafts + (mlet %store-monad ((guile (package->derivation + (guile-for-grafts) + system #:graft? #f))) + (graft-derivation* drv grafts + #:system system + #:guile guile)))))))) + (define* (locale-data source domain #:optional (directory domain)) "Return the locale data from 'po/DIRECTORY' in SOURCE, corresponding to @@ -754,7 +800,8 @@ (define* (compiled-guix source #:key (gzip (specification->package "gzip")) (bzip2 (specification->package "bzip2")) (xz (specification->package "xz")) - (guix (specification->package "guix"))) + (guix (specification->package "guix")) + (graft? #t)) "Return a file-like object that contains a compiled Guix." (define guile-avahi (specification->package "guile-avahi")) @@ -1024,25 +1071,34 @@ (define (built-modules node-subset) guile-lzma dependencies) #:guile guile-for-build - #:guile-version guile-version))) - (whole-package name modules dependencies - #:command command - #:guile guile-for-build - - ;; Include 'guix-daemon'. XXX: Here we inject an - ;; older snapshot of guix-daemon, but that's a good - ;; enough approximation for now. - #:daemon (specification->package "guix-daemon") - - #:info (info-manual source) - #:miscellany (miscellaneous-files source) - #:guile-version guile-version))) + #:guile-version guile-version)) + (obj + (whole-package name modules dependencies + #:command command + #:guile guile-for-build + + ;; Include 'guix-daemon'. XXX: Here we inject + ;; an older snapshot of guix-daemon, but + ;; that's a good enough approximation for now. + #:daemon (specification->package "guix-daemon") + + #:info (info-manual source) + #:miscellany (miscellaneous-files source) + #:guile-version guile-version))) + (if graft? + (explicit-grafting obj + (map (compose force cdr) %packages)) + obj))) ((= 0 pull-version) ;; Legacy 'guix pull': return the .scm and .go files as one ;; directory. - (built-modules (lambda (node) - (list (node-source node) - (node-compiled node))))) + (let ((obj (built-modules (lambda (node) + (list (node-source node) + (node-compiled node)))))) + (if graft? + (explicit-grafting obj + (map (compose force cdr) %packages)) + obj))) (else ;; Unsupported 'guix pull' version. #f))) @@ -1272,7 +1328,8 @@ (define (process-directory directory files output) (define* (guix-derivation source version #:optional (guile-version (effective-version)) #:key (pull-version 0) - channel-metadata) + channel-metadata + (graft? #t)) "Return, as a monadic value, the derivation to build the Guix from SOURCE for GUILE-VERSION. Use VERSION as the version string. Use CHANNEL-METADATA as the channel metadata sexp to include in (guix config). @@ -1309,7 +1366,11 @@ (define guile #:pull-version pull-version #:guile-version (if (>= pull-version 1) "3.0" guile-version) - #:guile-for-build guile))) + #:guile-for-build guile + #:graft? graft?))) (if guix - (lower-object guix) + (if graft? + (lower-object guix) + (without-grafting + (lower-object guix))) (return #f)))))