channels: Add 'profile-channels'.

* guix/channels.scm (profile-channels): New procedure.
* guix/scripts/describe.scm (display-profile-info)[channels]: Define in
terms of 'profile-channels'.
This commit is contained in:
Ludovic Courtès 2019-08-16 14:57:06 +02:00
parent b65bd33c36
commit a7c714d398
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 30 additions and 25 deletions

View File

@ -65,7 +65,9 @@
latest-channel-derivation latest-channel-derivation
channel-instances->manifest channel-instances->manifest
%channel-profile-hooks %channel-profile-hooks
channel-instances->derivation)) channel-instances->derivation
profile-channels))
;;; Commentary: ;;; Commentary:
;;; ;;;
@ -534,3 +536,27 @@ channel instances."
latest instances of CHANNELS." latest instances of CHANNELS."
(mlet %store-monad ((instances (latest-channel-instances* channels))) (mlet %store-monad ((instances (latest-channel-instances* channels)))
(channel-instances->derivation instances))) (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)
('url url)
('branch branch)
('commit commit)
_ ...))
(channel (name (string->symbol
(manifest-entry-name entry)))
(url url)
(commit commit)))
;; 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)))
;; Show most recently installed packages last.
(reverse
(manifest-entries (profile-manifest profile)))))

View File

@ -153,30 +153,9 @@ in the format specified by FMT."
(generation-number profile)) (generation-number profile))
(define channels (define channels
(map (lambda (entry) (profile-channels (if (zero? number)
(match (assq 'source (manifest-entry-properties entry))
(('source ('repository ('version 0)
('url url)
('branch branch)
('commit commit)
_ ...))
(channel (name (string->symbol (manifest-entry-name entry)))
(url url)
(commit commit)))
;; Pre-0.15.0 Guix does not provide that information,
;; so there's not much we can do in that case.
(_ (channel (name 'guix)
(url "?")
(commit "?")))))
;; Show most recently installed packages last.
(reverse
(manifest-entries
(profile-manifest
(if (zero? number)
profile profile
(generation-file-name profile number))))))) (generation-file-name profile number))))
(match fmt (match fmt
('human ('human