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.
This commit is contained in:
		
							parent
							
								
									471550c28c
								
							
						
					
					
						commit
						6d39f0cb77
					
				
					 2 changed files with 58 additions and 11 deletions
				
			
		|  | @ -4608,7 +4608,12 @@ $ guix describe -f channels | |||
|         (name 'guix) | ||||
|         (url "https://git.savannah.gnu.org/git/guix.git") | ||||
|         (commit | ||||
|           "e0fa68c7718fffd33d81af415279d6ddb518f727"))) | ||||
|           "e0fa68c7718fffd33d81af415279d6ddb518f727") | ||||
|         (introduction | ||||
|           (make-channel-introduction | ||||
|             "9edb3f66fd807b096b48283debdcddccfea34bad" | ||||
|             (openpgp-fingerprint | ||||
|               "BBB0 2DDF 2CEA F6A8 0D1D  E643 A2A0 6DF2 A33A 54FA"))))) | ||||
| @end example | ||||
| 
 | ||||
| @noindent | ||||
|  | @ -4634,6 +4639,12 @@ produce human-readable output; | |||
| produce a list of channel specifications that can be passed to @command{guix | ||||
| pull -C} or installed as @file{~/.config/guix/channels.scm} (@pxref{Invoking | ||||
| guix pull}); | ||||
| @item channels-sans-intro | ||||
| like @code{channels}, but omit the @code{introduction} field; use it to | ||||
| produce a channel specification suitable for Guix version 1.1.0 or | ||||
| earlier---the @code{introduction} field has to do with channel | ||||
| authentication (@pxref{Channels, Channel Authentication}) and is not | ||||
| supported by these older versions; | ||||
| @item json | ||||
| @cindex JSON | ||||
| produce a list of channel specifications in JSON format; | ||||
|  |  | |||
|  | @ -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 | ||||
|  |  | |||
		Reference in a new issue