me
/
guix
Archived
1
0
Fork 0
Code

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.
master
Ludovic Courtès 2021-01-10 18:30:57 +01:00
parent 9fd7b050e2
commit 9272cc700e
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 63 additions and 43 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

74
guix/channels.scm
View File

@ -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,24 +802,12 @@ derivation."
(derivation-input-derivation input))))
(derivation-inputs drv))))
(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)
(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)))
(manifest-entry
(name (symbol->string (channel-name channel)))
(version (string-take commit 7))
(item (if (guix-channel? channel)
(if (old-style-guix? drv)
(whole-package-for-legacy (string-append name "-" version)
drv)
drv)
drv))
(properties
`((source (repository
`(repository
(version 0)
(url ,(channel-url channel))
(branch ,(channel-branch channel))
@ -835,7 +823,25 @@ channel instances."
,(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)))
(manifest-entry
(name (symbol->string (channel-name channel)))
(version (string-take commit 7))
(item (if (guix-channel? channel)
(if (old-style-guix? drv)
(whole-package-for-legacy (string-append name "-" version)
drv)
drv)
drv))
(properties
`((source ,(channel-instance->sexp instance)))))))
(mlet* %store-monad ((derivations (channel-instance-derivations instances))
(entries -> (map instance->entry instances derivations)))
@ -900,18 +906,17 @@ to 'latest-channel-instances'."
validate-pull)))
(channel-instances->derivation instances)))
(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)
(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 (string->symbol
(manifest-entry-name entry)))
rest ...)
(channel (name name)
(url url)
(commit commit)
(introduction
@ -920,11 +925,26 @@ PROFILE is not a profile created by 'guix pull', return the empty list."
(('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)))
#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 manifest-entry-channel
;; Show most recently installed packages last.
(reverse
(manifest-entries (profile-manifest profile)))))