summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2021-01-10 18:30:57 +0100
committerLudovic Courtès <ludo@gnu.org>2021-02-01 17:32:35 +0100
commit9272cc700efbc5b80f1d3e0d43017304f37a3aeb (patch)
tree427da178f5e3cb11314719efcc9469714777d3a9
parent9fd7b050e2198c89f0763fe79f5c541b77b8e5c9 (diff)
channels: Factorize 'manifest-entry-channel' and channel serialization.
* 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.
-rw-r--r--guix/channels.scm106
1 files 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)))))