From: "Ludovic Courtès" <ludo@gnu.org>
To: 45896@debbugs.gnu.org
Subject: bug#45896: [PATCH 1/3] channels: Record 'guix' channel metadata in (guix config).
Date: Wed, 27 Jan 2021 22:51:28 +0100 [thread overview]
Message-ID: <20210127215130.24530-1-ludo@gnu.org> (raw)
In-Reply-To: <874kjixf59.fsf@inria.fr>
Partially fixes <https://bugs.gnu.org/45896>.
* guix/config.scm.in (%channel-metadata): New variable.
* guix/describe.scm (channel-metadata): Use it.
(current-channels): New procedure.
(current-profile-entries): Clarify docstring.
* guix/self.scm (compiled-guix): Add #:channel-metadata and pass it to
'make-config.scm'.
(make-config.scm): Add #:channel-metadata and define '%channel-metadata'
in the generated file.
(guix-derivation): Add #:channel-metadata and pass it to 'compiled-guix'.
* guix/channels.scm (build-from-source): Replace 'name', 'source', and
'commit' parameters with 'instance'. Pass #:channel-metadata to BUILD.
(build-channel-instance): Adjust accordingly.
* build-aux/build-self.scm (build-program): Add #:channel-metadata
and pass it to 'guix-derivation'.
(build): Add #:channel-metadata and pass it to 'build-program'.
* guix/scripts/describe.scm (display-profile-info): Add optional
'channels' parameter. Pass it to 'display-profile-content'.
(display-profile-content): Add optional 'channels' parameter and honor
it. Iterate on CHANNELS rather than on the manifest entries of
PROFILE.
(guix-describe): When PROFILE is #f, call 'current-channels' and pass it
to 'display-profile-info', unless it returns the empty list.
---
build-aux/build-self.scm | 11 ++++--
guix/channels.scm | 30 ++++++++++-------
guix/config.scm.in | 11 +++++-
guix/describe.scm | 28 ++++++++++++++--
guix/scripts/describe.scm | 70 +++++++++++++++++++--------------------
guix/self.scm | 25 +++++++++++---
6 files changed, 116 insertions(+), 59 deletions(-)
diff --git a/build-aux/build-self.scm b/build-aux/build-self.scm
index d5bc5fb46e..6a3b9c83d4 100644
--- a/build-aux/build-self.scm
+++ b/build-aux/build-self.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -241,7 +241,7 @@ interface (FFI) of Guile.")
(define* (build-program source version
#:optional (guile-version (effective-version))
- #:key (pull-version 0))
+ #:key (pull-version 0) (channel-metadata #f))
"Return a program that computes the derivation to build Guix from SOURCE."
(define select?
;; Select every module but (guix config) and non-Guix modules.
@@ -359,6 +359,8 @@ interface (FFI) of Guile.")
(run-with-store store
(guix-derivation source version
#$guile-version
+ #:channel-metadata
+ '#$channel-metadata
#:pull-version
#$pull-version)
#:system system)
@@ -380,7 +382,9 @@ interface (FFI) of Guile.")
;; The procedure below is our return value.
(define* (build source
- #:key verbose? (version (date-version-string)) system
+ #:key verbose?
+ (version (date-version-string)) channel-metadata
+ system
(pull-version 0)
;; For the standalone Guix, default to Guile 3.0. For old
@@ -397,6 +401,7 @@ files."
;; Build the build program and then use it as a trampoline to build from
;; SOURCE.
(mlet %store-monad ((build (build-program source version guile-version
+ #:channel-metadata channel-metadata
#:pull-version pull-version))
(system (if system (return system) (current-system)))
(home -> (getenv "HOME"))
diff --git a/guix/channels.scm b/guix/channels.scm
index e7e1eb6fd0..3cc3b4c438 100644
--- a/guix/channels.scm
+++ b/guix/channels.scm
@@ -626,16 +626,23 @@ that unconditionally resumes the continuation."
(values (run-with-store store mvalue)
store))))
-(define* (build-from-source name source
- #:key core verbose? commit
- (dependencies '()))
- "Return a derivation to build Guix from SOURCE, using the self-build script
-contained therein; use COMMIT as the version string. When CORE is true, build
-package modules under SOURCE using CORE, an instance of Guix."
+(define* (build-from-source instance
+ #:key core verbose? (dependencies '()))
+ "Return a derivation to build Guix from INSTANCE, using the self-build
+script contained therein. When CORE is true, build package modules under
+SOURCE using CORE, an instance of Guix."
+ (define name
+ (symbol->string
+ (channel-name (channel-instance-channel instance))))
+ (define source
+ (channel-instance-checkout instance))
+ (define commit
+ (channel-instance-commit instance))
+
;; Running the self-build script makes it easier to update the build
;; procedure: the self-build script of the Guix-to-be-installed contains the
;; right dependencies, build procedure, etc., which the Guix-in-use may not
- ;; be know.
+ ;; know.
(define script
(string-append source "/" %self-build-file))
@@ -661,7 +668,9 @@ package modules under SOURCE using CORE, an instance of Guix."
;; cause us to redo half of the BUILD computation several times just
;; to realize it gives the same result.
(with-trivial-build-handler
- (build source #:verbose? verbose? #:version commit
+ (build source
+ #:verbose? verbose? #:version commit
+ #:channel-metadata (channel-instance->sexp instance)
#:pull-version %pull-version))))
;; Build a set of modules that extend Guix using the standard method.
@@ -672,10 +681,7 @@ package modules under SOURCE using CORE, an instance of Guix."
"Return, as a monadic value, the derivation for INSTANCE, a channel
instance. DEPENDENCIES is a list of extensions providing Guile modules that
INSTANCE depends on."
- (build-from-source (symbol->string
- (channel-name (channel-instance-channel instance)))
- (channel-instance-checkout instance)
- #:commit (channel-instance-commit instance)
+ (build-from-source instance
#:core core
#:dependencies dependencies))
diff --git a/guix/config.scm.in b/guix/config.scm.in
index b2901735d8..223c9eb418 100644
--- a/guix/config.scm.in
+++ b/guix/config.scm.in
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2018, 2019, 2021 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2017 Caleb Ristvedt <caleb.ristvedt@cune.org>
;;;
;;; This file is part of GNU Guix.
@@ -23,6 +23,8 @@
%guix-bug-report-address
%guix-home-page-url
+ %channel-metadata
+
%storedir
%localstatedir
%sysconfdir
@@ -56,6 +58,13 @@
(define %guix-home-page-url
"@PACKAGE_URL@")
+(define %channel-metadata
+ ;; When true, this is an sexp containing metadata for the 'guix' channel
+ ;; this file was built from. This is used by (guix describe).
+
+ ;; TODO: Implement 'configure.ac' machinery to initialize it.
+ #f)
+
(define %storedir
"@storedir@")
diff --git a/guix/describe.scm b/guix/describe.scm
index ac89fc0d7c..6a31c707f0 100644
--- a/guix/describe.scm
+++ b/guix/describe.scm
@@ -23,12 +23,13 @@
#:use-module ((guix utils) #:select (location-file))
#:use-module ((guix store) #:select (%store-prefix store-path?))
#:use-module ((guix config) #:select (%state-directory))
- #:autoload (guix channels) (sexp->channel)
+ #:autoload (guix channels) (sexp->channel manifest-entry-channel)
#:use-module (srfi srfi-1)
#:use-module (ice-9 match)
#:export (current-profile
current-profile-date
current-profile-entries
+ current-channels
package-path-entries
package-provenance
@@ -87,10 +88,19 @@ as a number of seconds since the Epoch, or #f if it could not be determined."
(string-append (dirname file) "/" target)))))
(const #f)))))))
+(define (channel-metadata)
+ "Return the 'guix' channel metadata sexp from (guix config) if available;
+otherwise return #f."
+ ;; Older 'build-self.scm' would create a (guix config) file without the
+ ;; '%channel-metadata' variable. Thus, properly deal with a lack of
+ ;; information.
+ (let ((module (resolve-interface '(guix config))))
+ (and=> (module-variable module '%channel-metadata) variable-ref)))
+
(define current-profile-entries
(mlambda ()
"Return the list of entries in the 'guix pull' profile the calling process
-lives in, or #f if this is not applicable."
+lives in, or the empty list if this is not applicable."
(match (current-profile)
(#f '())
(profile
@@ -105,6 +115,20 @@ lives in, or #f if this is not applicable."
(string=? (manifest-entry-name entry) "guix"))
(current-profile-entries))))
+(define current-channels
+ (mlambda ()
+ "Return the list of channels currently available, including the 'guix'
+channel. Return the empty list if this information is missing."
+ (match (current-profile-entries)
+ (()
+ ;; As a fallback, if we're not running from a profile, use 'guix'
+ ;; channel metadata from (guix config).
+ (match (channel-metadata)
+ (#f '())
+ (sexp (or (and=> (sexp->channel sexp 'guix) list) '()))))
+ (entries
+ (filter-map manifest-entry-channel entries)))))
+
(define (package-path-entries)
"Return two values: the list of package path entries to be added to the
package search path, and the list to be added to %LOAD-COMPILED-PATH. These
diff --git a/guix/scripts/describe.scm b/guix/scripts/describe.scm
index e47d207ee0..cd5d3838a8 100644
--- a/guix/scripts/describe.scm
+++ b/guix/scripts/describe.scm
@@ -182,20 +182,18 @@ string is ~a.~%")
(current-output-port))))
(display-package-search-path fmt)))
-(define (display-profile-info profile fmt)
+(define* (display-profile-info profile fmt
+ #:optional
+ (channels (profile-channels profile)))
"Display information about PROFILE, a profile as created by (guix channels),
-in the format specified by FMT."
+in the format specified by FMT. PROFILE can be #f, in which case CHANNELS is
+what matters."
(define number
- (generation-number profile))
-
- (define channels
- (profile-channels (if (zero? number)
- profile
- (generation-file-name profile number))))
+ (and profile (generation-number profile)))
(match fmt
('human
- (display-profile-content profile number))
+ (display-profile-content profile number channels))
('channels
(pretty-print `(list ,@(map channel->code channels))))
('channels-sans-intro
@@ -213,33 +211,29 @@ in the format specified by FMT."
channels))))
(display-package-search-path fmt))
-(define (display-profile-content profile number)
- "Display the packages in PROFILE, generation NUMBER, in a human-readable
-way and displaying details about the channel's source code."
- (display-generation profile number)
- (for-each (lambda (entry)
+(define* (display-profile-content profile number
+ #:optional
+ (channels (profile-channels profile)))
+ "Display CHANNELS along with PROFILE info, generation NUMBER, in a
+human-readable way and displaying details about the channel's source code.
+PROFILE and NUMBER "
+ (when (and number profile)
+ (display-generation profile number))
+
+ (for-each (lambda (channel)
(format #t " ~a ~a~%"
- (manifest-entry-name entry)
- (manifest-entry-version entry))
- (match (manifest-entry-channel entry)
- ((? channel? channel)
- (format #t (G_ " repository URL: ~a~%")
- (channel-url channel))
- (when (channel-branch channel)
- (format #t (G_ " branch: ~a~%")
- (channel-branch channel)))
- (format #t (G_ " commit: ~a~%")
- (if (supports-hyperlinks?)
- (channel-commit-hyperlink channel)
- (channel-commit channel))))
- (_ #f)))
-
- ;; Show most recently installed packages last.
- (reverse
- (manifest-entries
- (profile-manifest (if (zero? number)
- profile
- (generation-file-name profile number)))))))
+ (channel-name channel)
+ (string-take (channel-commit channel) 7))
+ (format #t (G_ " repository URL: ~a~%")
+ (channel-url channel))
+ (when (channel-branch channel)
+ (format #t (G_ " branch: ~a~%")
+ (channel-branch channel)))
+ (format #t (G_ " commit: ~a~%")
+ (if (supports-hyperlinks?)
+ (channel-commit-hyperlink channel)
+ (channel-commit channel))))
+ channels))
(define %vcs-web-views
;; Hard-coded list of host names and corresponding web view URL templates.
@@ -295,6 +289,10 @@ text. The hyperlink links to a web view of COMMIT, when available."
(with-error-handling
(match profile
(#f
- (display-checkout-info format))
+ (match (current-channels)
+ (()
+ (display-checkout-info format))
+ (channels
+ (display-profile-info #f format channels))))
(profile
(display-profile-info (canonicalize-profile profile) format))))))
diff --git a/guix/self.scm b/guix/self.scm
index 15c8ad4eb9..35fba1152d 100644
--- a/guix/self.scm
+++ b/guix/self.scm
@@ -793,7 +793,9 @@ itself."
(((labels packages _ ...) ...)
(cons package packages))))
-(define* (compiled-guix source #:key (version %guix-version)
+(define* (compiled-guix source #:key
+ (version %guix-version)
+ (channel-metadata #f)
(pull-version 1)
(name (string-append "guix-" version))
(guile-version (effective-version))
@@ -977,6 +979,8 @@ itself."
%guix-package-name
#:package-version
version
+ #:channel-metadata
+ channel-metadata
#:bug-report-address
%guix-bug-report-address
#:home-page-url
@@ -1070,6 +1074,7 @@ itself."
(define* (make-config.scm #:key gzip xz bzip2
(package-name "GNU Guix")
(package-version "0")
+ (channel-metadata #f)
(bug-report-address "bug-guix@gnu.org")
(home-page-url "https://guix.gnu.org"))
@@ -1083,6 +1088,7 @@ itself."
%guix-version
%guix-bug-report-address
%guix-home-page-url
+ %channel-metadata
%system
%store-directory
%state-directory
@@ -1125,6 +1131,11 @@ itself."
(define %guix-bug-report-address #$bug-report-address)
(define %guix-home-page-url #$home-page-url)
+ (define %channel-metadata
+ ;; Metadata for the 'guix' channel in use. This
+ ;; information is used by (guix describe).
+ '#$channel-metadata)
+
(define %gzip
#+(and gzip (file-append gzip "/bin/gzip")))
(define %bzip2
@@ -1249,11 +1260,14 @@ containing MODULE-FILES and possibly other files as well."
(define* (guix-derivation source version
#:optional (guile-version (effective-version))
- #:key (pull-version 0))
+ #:key (pull-version 0)
+ channel-metadata)
"Return, as a monadic value, the derivation to build the Guix from SOURCE
-for GUILE-VERSION. Use VERSION as the version string. PULL-VERSION specifies
-the version of the 'guix pull' protocol. Return #f if this PULL-VERSION value
-is not supported."
+for GUILE-VERSION. Use VERSION as the version string. Use CHANNEL-METADATA
+as the channel metadata sexp to include in (guix config).
+
+PULL-VERSION specifies the version of the 'guix pull' protocol. Return #f if
+this PULL-VERSION value is not supported."
(define (shorten version)
(if (and (string-every char-set:hex-digit version)
(> (string-length version) 9))
@@ -1278,6 +1292,7 @@ is not supported."
(set-guile-for-build guile)
(let ((guix (compiled-guix source
#:version version
+ #:channel-metadata channel-metadata
#:name (string-append "guix-"
(shorten version))
#:pull-version pull-version
--
2.30.0
next prev parent reply other threads:[~2021-01-27 21:52 UTC|newest]
Thread overview: 8+ messages / expand[flat|nested] mbox.gz Atom feed top
2021-01-15 17:51 bug#45896: Non-pull ‘guix’ should know its channels Ludovic Courtès
2021-01-26 13:16 ` Ludovic Courtès
2021-01-27 21:53 ` Ludovic Courtès
2021-01-27 21:51 ` Ludovic Courtès [this message]
2021-01-27 21:51 ` bug#45896: [PATCH 2/3] build: Add '--with-channel-commit' and related configure flags Ludovic Courtès
2021-01-27 21:51 ` bug#45896: [PATCH 3/3] gnu: guix: Pass the '--with-channel-commit' configure flag Ludovic Courtès
2021-02-04 12:46 ` bug#45896: Non-pull ‘guix’ should know its channels Ludovic Courtès
2021-01-27 21:53 ` Ludovic Courtès
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://guix.gnu.org/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=20210127215130.24530-1-ludo@gnu.org \
--to=ludo@gnu.org \
--cc=45896@debbugs.gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/guix.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).