From 6d39f0cb7791ff1a6feb0084dad9851a820a900c Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Thu, 25 Jun 2020 17:50:48 +0200
Subject: 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.
---
 guix/scripts/describe.scm | 56 ++++++++++++++++++++++++++++++++++++++---------
 1 file changed, 46 insertions(+), 10 deletions(-)

(limited to 'guix/scripts/describe.scm')

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
-- 
cgit v1.2.3