From: "Ludovic Courtès" <ludo@gnu.org>
To: 45919@debbugs.gnu.org
Subject: [bug#45919] [PATCH 4/8] channels: Factorize 'manifest-entry-channel' and channel serialization.
Date: Sat, 16 Jan 2021 19:34:05 +0100 [thread overview]
Message-ID: <20210116183409.31229-4-ludo@gnu.org> (raw)
In-Reply-To: <20210116183409.31229-1-ludo@gnu.org>
* guix/channels.scm (sexp->channel, manifest-entry-channel): New
procedures.
(profile-channels): Replace lambda by 'manifest-entry-channel'.
(channel-instance->sexp): New procedure.
(channel-instances->manifest)[instance->entry]: Use
'channel-instance->sexp' instead of inline code.
---
guix/channels.scm | 106 +++++++++++++++++++++++++++-------------------
1 file changed, 63 insertions(+), 43 deletions(-)
diff --git a/guix/channels.scm b/guix/channels.scm
index 0c84eed477..65a0d849ec 100644
--- a/guix/channels.scm
+++ b/guix/channels.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
;;;
@@ -802,13 +802,35 @@ derivation."
(derivation-input-derivation input))))
(derivation-inputs drv))))
+(define (channel-instance->sexp instance)
+ "Return an sexp representation of INSTANCE, a channel instance."
+ (let* ((commit (channel-instance-commit instance))
+ (channel (channel-instance-channel instance))
+ (intro (channel-introduction channel)))
+ `(repository
+ (version 0)
+ (url ,(channel-url channel))
+ (branch ,(channel-branch channel))
+ (commit ,commit)
+ ,@(if intro
+ `((introduction
+ (channel-introduction
+ (version 0)
+ (commit
+ ,(channel-introduction-first-signed-commit
+ intro))
+ (signer
+ ,(openpgp-format-fingerprint
+ (channel-introduction-first-commit-signer
+ intro))))))
+ '()))))
+
(define (channel-instances->manifest instances)
"Return a profile manifest with entries for all of INSTANCES, a list of
channel instances."
(define (instance->entry instance drv)
- (let* ((commit (channel-instance-commit instance))
- (channel (channel-instance-channel instance))
- (intro (channel-introduction channel)))
+ (let ((commit (channel-instance-commit instance))
+ (channel (channel-instance-channel instance)))
(manifest-entry
(name (symbol->string (channel-name channel)))
(version (string-take commit 7))
@@ -819,23 +841,7 @@ channel instances."
drv)
drv))
(properties
- `((source (repository
- (version 0)
- (url ,(channel-url channel))
- (branch ,(channel-branch channel))
- (commit ,commit)
- ,@(if intro
- `((introduction
- (channel-introduction
- (version 0)
- (commit
- ,(channel-introduction-first-signed-commit
- intro))
- (signer
- ,(openpgp-format-fingerprint
- (channel-introduction-first-commit-signer
- intro))))))
- '()))))))))
+ `((source ,(channel-instance->sexp instance)))))))
(mlet* %store-monad ((derivations (channel-instance-derivations instances))
(entries -> (map instance->entry instances derivations)))
@@ -900,31 +906,45 @@ to 'latest-channel-instances'."
validate-pull)))
(channel-instances->derivation instances)))
+(define* (sexp->channel sexp #:optional (name 'channel))
+ "Read SEXP, a provenance sexp as created by 'channel-instance->sexp',
+and return a channel called NAME. Return #f if the sexp does not have the
+expected structure."
+ (match sexp
+ (('repository ('version 0)
+ ('url url)
+ ('branch branch)
+ ('commit commit)
+ rest ...)
+ (channel (name name)
+ (url url)
+ (commit commit)
+ (introduction
+ (match (assq 'introduction rest)
+ (#f #f)
+ (('introduction intro)
+ (sexp->channel-introduction intro))))))
+
+ (_ #f)))
+
+(define (manifest-entry-channel entry)
+ "Return the channel ENTRY corresponds to, or #f if that information is
+missing or unreadable. ENTRY must be an entry created by
+'channel-instances->manifest', with the 'source' property."
+ (let ((name (string->symbol (manifest-entry-name entry))))
+ (match (assq-ref (manifest-entry-properties entry) 'source)
+ ((sexp)
+ (sexp->channel sexp name))
+ (_
+ ;; No channel information for this manifest entry.
+ ;; XXX: Pre-0.15.0 Guix did not provide that information,
+ ;; but there's not much we can do in that case.
+ #f))))
+
(define (profile-channels profile)
"Return the list of channels corresponding to entries in PROFILE. If
PROFILE is not a profile created by 'guix pull', return the empty list."
- (filter-map (lambda (entry)
- (match (assq 'source (manifest-entry-properties entry))
- (('source ('repository ('version 0)
- ('url url)
- ('branch branch)
- ('commit commit)
- rest ...))
- (channel (name (string->symbol
- (manifest-entry-name entry)))
- (url url)
- (commit commit)
- (introduction
- (match (assq 'introduction rest)
- (#f #f)
- (('introduction intro)
- (sexp->channel-introduction intro))))))
-
- ;; No channel information for this manifest entry.
- ;; XXX: Pre-0.15.0 Guix did not provide that information,
- ;; but there's not much we can do in that case.
- (_ #f)))
-
+ (filter-map manifest-entry-channel
;; Show most recently installed packages last.
(reverse
(manifest-entries (profile-manifest profile)))))
--
2.30.0
next prev parent reply other threads:[~2021-01-16 18:35 UTC|newest]
Thread overview: 12+ messages / expand[flat|nested] mbox.gz Atom feed top
2021-01-16 18:29 [bug#45919] [PATCH 0/8] Exporting a manifest and channels from a profile Ludovic Courtès
2021-01-16 18:34 ` [bug#45919] [PATCH 1/8] profiles: Add 'manifest->code' Ludovic Courtès
2021-01-16 18:34 ` [bug#45919] [PATCH 2/8] utils: Add 'version-unique-prefix' Ludovic Courtès
2021-01-16 18:34 ` [bug#45919] [PATCH 3/8] guix package: Add '--export-manifest' Ludovic Courtès
2021-01-16 18:34 ` Ludovic Courtès [this message]
2021-01-16 18:34 ` [bug#45919] [PATCH 5/8] channels: Add the channel name to channel sexps Ludovic Courtès
2021-01-16 18:34 ` [bug#45919] [PATCH 6/8] guix describe: Use 'manifest-entry-channel' Ludovic Courtès
2021-01-16 18:34 ` [bug#45919] [PATCH 7/8] channels: Add 'channel->code' Ludovic Courtès
2021-01-16 18:34 ` [bug#45919] [PATCH 8/8] guix package: Add '--export-channels' Ludovic Courtès
[not found] ` <87wnvyv7w6.fsf@gnu.org>
[not found] ` <871re5t2lg.fsf@ambrevar.xyz>
2021-01-29 17:57 ` [bug#45919] [PATCH 0/8] Exporting a manifest and channels from a profile Pierre Neidhardt
[not found] ` <865z3fh8pn.fsf@gmail.com>
[not found] ` <87eei3quma.fsf@ambrevar.xyz>
2021-01-30 14:31 ` zimoun
[not found] ` <87o8h6fs1n.fsf_-_@gnu.org>
[not found] ` <875z3dqaq5.fsf@ambrevar.xyz>
[not found] ` <8735yfhqcd.fsf_-_@gnu.org>
[not found] ` <87v9bbolbq.fsf@ambrevar.xyz>
2021-02-01 17:04 ` bug#45919: " 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=20210116183409.31229-4-ludo@gnu.org \
--to=ludo@gnu.org \
--cc=45919@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).