summaryrefslogtreecommitdiff
path: root/guix
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2020-06-25 17:50:48 +0200
committerLudovic Courtès <ludo@gnu.org>2020-07-01 23:34:51 +0200
commit6d39f0cb7791ff1a6feb0084dad9851a820a900c (patch)
tree86fde878fd435f9010bf5f9d004fb9265795cb65 /guix
parent471550c28cb425c15f8f5fa61fdeb885f479e2ae (diff)
guix describe: Display channel introductions and add 'channels-sans-intro'.
* guix/scripts/describe.scm (%available-formats): Add "channels-sans-intro". (channel->sexp): Add #:include-introduction?. Emit CHANNEL's intro if INCLUDE-INTRODUCTION? is true and CHANNEL has an introduction. (channel->json): Include CHANNEL's introduction, if any. (channel->recutils): Likewise. (display-profile-info): Add 'channels-sans-intro' case. * doc/guix.texi (Invoking guix describe): Add introduction in example. Add 'channels-sans-intro' case.
Diffstat (limited to 'guix')
-rw-r--r--guix/scripts/describe.scm56
1 files changed, 46 insertions, 10 deletions
diff --git a/guix/scripts/describe.scm b/guix/scripts/describe.scm
index ea982955da..bc868ffbbf 100644
--- a/guix/scripts/describe.scm
+++ b/guix/scripts/describe.scm
@@ -26,9 +26,11 @@
#:use-module (guix scripts)
#:use-module (guix describe)
#:use-module (guix profiles)
+ #:autoload (guix openpgp) (openpgp-format-fingerprint)
#:use-module (git)
#:use-module (json)
#:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-26)
#:use-module (srfi srfi-37)
#:use-module (ice-9 match)
#:use-module (ice-9 format)
@@ -43,7 +45,8 @@
;;;
;;; Command-line options.
;;;
-(define %available-formats '("human" "channels" "json" "recutils"))
+(define %available-formats
+ '("human" "channels" "channels-sans-intro" "json" "recutils"))
(define (list-formats)
(display (G_ "The available formats are:\n"))
@@ -110,21 +113,50 @@ 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)
- `(channel
- (name ',(channel-name channel))
- (url ,(channel-url channel))
- (commit ,(channel-commit channel))))
+(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 `((name . ,(channel-name channel))
- (url . ,(channel-url channel))
- (commit . ,(channel-commit channel)))))
+ (scm->json-string
+ (let ((intro (channel-introduction channel)))
+ `((name . ,(channel-name channel))
+ (url . ,(channel-url channel))
+ (commit . ,(channel-commit channel))
+ ,@(if intro
+ `((introduction
+ . ((commit . ,(channel-introduction-first-signed-commit
+ intro))
+ (signer . ,(openpgp-format-fingerprint
+ (channel-introduction-first-commit-signer
+ intro))))))
+ '())))))
(define (channel->recutils channel port)
+ (define intro
+ (channel-introduction channel))
+
(format port "name: ~a~%" (channel-name channel))
(format port "url: ~a~%" (channel-url channel))
- (format port "commit: ~a~%" (channel-commit channel)))
+ (format port "commit: ~a~%" (channel-commit channel))
+ (when intro
+ (format port "introductioncommit: ~a~%"
+ (channel-introduction-first-signed-commit intro))
+ (format port "introductionsigner: ~a~%"
+ (openpgp-format-fingerprint
+ (channel-introduction-first-commit-signer intro)))))
(define (display-checkout-info fmt)
"Display information about the current checkout according to FMT, a symbol
@@ -182,6 +214,10 @@ in the format specified by FMT."
(display-profile-content profile number))
('channels
(pretty-print `(list ,@(map channel->sexp channels))))
+ ('channels-sans-intro
+ (pretty-print `(list ,@(map (cut channel->sexp <>
+ #:include-introduction? #f)
+ channels))))
('json
(format #t "[~a]~%" (string-join (map channel->json channels) ",")))
('recutils