aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2021-01-10 21:51:18 +0100
committerLudovic Courtès <ludo@gnu.org>2021-02-01 17:32:35 +0100
commit60d72f536437bcef2a4e02faa1fe0c8076049fcc (patch)
tree77380eb1131be04537c3c69cfeb5a8addd4de62f
parent1b88b7bad297a97bbbe5334eacb501aadc8ddf8a (diff)
downloadguix-60d72f536437bcef2a4e02faa1fe0c8076049fcc.tar
guix-60d72f536437bcef2a4e02faa1fe0c8076049fcc.tar.gz
channels: Add 'channel->code'.
* guix/channels.scm (channel->code): New procedure, taken from... * guix/scripts/describe.scm (channel->sexp): ... here. Adjust callers accordingly.
-rw-r--r--guix/channels.scm19
-rw-r--r--guix/scripts/describe.scm22
2 files changed, 22 insertions, 19 deletions
diff --git a/guix/channels.scm b/guix/channels.scm
index 743b4a25b7..cdef77637d 100644
--- a/guix/channels.scm
+++ b/guix/channels.scm
@@ -92,6 +92,7 @@
profile-channels
manifest-entry-channel
+ channel->code
channel-news-entry?
channel-news-entry-commit
@@ -957,6 +958,24 @@ PROFILE is not a profile created by 'guix pull', return the empty list."
(reverse
(manifest-entries (profile-manifest profile)))))
+(define* (channel->code channel #:key (include-introduction? #t))
+ "Return code (an sexp) to build CHANNEL. When INCLUDE-INTRODUCTION? is
+true, include its introduction, if any."
+ (let ((intro (and include-introduction?
+ (channel-introduction channel))))
+ `(channel
+ (name ',(channel-name channel))
+ (url ,(channel-url channel))
+ (commit ,(channel-commit channel))
+ ,@(if intro
+ `((introduction (make-channel-introduction
+ ,(channel-introduction-first-signed-commit intro)
+ (openpgp-fingerprint
+ ,(openpgp-format-fingerprint
+ (channel-introduction-first-commit-signer
+ intro))))))
+ '()))))
+
;;;
;;; News.
diff --git a/guix/scripts/describe.scm b/guix/scripts/describe.scm
index b7ec029ba8..e47d207ee0 100644
--- a/guix/scripts/describe.scm
+++ b/guix/scripts/describe.scm
@@ -113,22 +113,6 @@ Display information about the channels currently in use.\n"))
(_
(warning (G_ "'GUIX_PACKAGE_PATH' is set but it is not captured~%")))))))
-(define* (channel->sexp channel #:key (include-introduction? #t))
- (let ((intro (and include-introduction?
- (channel-introduction channel))))
- `(channel
- (name ',(channel-name channel))
- (url ,(channel-url channel))
- (commit ,(channel-commit channel))
- ,@(if intro
- `((introduction (make-channel-introduction
- ,(channel-introduction-first-signed-commit intro)
- (openpgp-fingerprint
- ,(openpgp-format-fingerprint
- (channel-introduction-first-commit-signer
- intro))))))
- '()))))
-
(define (channel->json channel)
(scm->json-string
(let ((intro (channel-introduction channel)))
@@ -183,7 +167,7 @@ string is ~a.~%")
(format #t (G_ " branch: ~a~%") (reference-shorthand head))
(format #t (G_ " commit: ~a~%") commit))
('channels
- (pretty-print `(list ,(channel->sexp (channel (name 'guix)
+ (pretty-print `(list ,(channel->code (channel (name 'guix)
(url (dirname directory))
(commit commit))))))
('json
@@ -213,9 +197,9 @@ in the format specified by FMT."
('human
(display-profile-content profile number))
('channels
- (pretty-print `(list ,@(map channel->sexp channels))))
+ (pretty-print `(list ,@(map channel->code channels))))
('channels-sans-intro
- (pretty-print `(list ,@(map (cut channel->sexp <>
+ (pretty-print `(list ,@(map (cut channel->code <>
#:include-introduction? #f)
channels))))
('json