channels: Add 'channel->code'.
* guix/channels.scm (channel->code): New procedure, taken from... * guix/scripts/describe.scm (channel->sexp): ... here. Adjust callers accordingly.
This commit is contained in:
parent
1b88b7bad2
commit
60d72f5364
@ -92,6 +92,7 @@
|
|||||||
|
|
||||||
profile-channels
|
profile-channels
|
||||||
manifest-entry-channel
|
manifest-entry-channel
|
||||||
|
channel->code
|
||||||
|
|
||||||
channel-news-entry?
|
channel-news-entry?
|
||||||
channel-news-entry-commit
|
channel-news-entry-commit
|
||||||
@ -957,6 +958,24 @@ PROFILE is not a profile created by 'guix pull', return the empty list."
|
|||||||
(reverse
|
(reverse
|
||||||
(manifest-entries (profile-manifest profile)))))
|
(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.
|
;;; News.
|
||||||
|
@ -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~%")))))))
|
(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)
|
(define (channel->json channel)
|
||||||
(scm->json-string
|
(scm->json-string
|
||||||
(let ((intro (channel-introduction channel)))
|
(let ((intro (channel-introduction channel)))
|
||||||
@ -183,7 +167,7 @@ string is ~a.~%")
|
|||||||
(format #t (G_ " branch: ~a~%") (reference-shorthand head))
|
(format #t (G_ " branch: ~a~%") (reference-shorthand head))
|
||||||
(format #t (G_ " commit: ~a~%") commit))
|
(format #t (G_ " commit: ~a~%") commit))
|
||||||
('channels
|
('channels
|
||||||
(pretty-print `(list ,(channel->sexp (channel (name 'guix)
|
(pretty-print `(list ,(channel->code (channel (name 'guix)
|
||||||
(url (dirname directory))
|
(url (dirname directory))
|
||||||
(commit commit))))))
|
(commit commit))))))
|
||||||
('json
|
('json
|
||||||
@ -213,9 +197,9 @@ in the format specified by FMT."
|
|||||||
('human
|
('human
|
||||||
(display-profile-content profile number))
|
(display-profile-content profile number))
|
||||||
('channels
|
('channels
|
||||||
(pretty-print `(list ,@(map channel->sexp channels))))
|
(pretty-print `(list ,@(map channel->code channels))))
|
||||||
('channels-sans-intro
|
('channels-sans-intro
|
||||||
(pretty-print `(list ,@(map (cut channel->sexp <>
|
(pretty-print `(list ,@(map (cut channel->code <>
|
||||||
#:include-introduction? #f)
|
#:include-introduction? #f)
|
||||||
channels))))
|
channels))))
|
||||||
('json
|
('json
|
||||||
|
Loading…
Reference in New Issue
Block a user