From 81a40ee0cb925bc39e3044bddcfdd38ddb04f04d Mon Sep 17 00:00:00 2001
From: Oleg Pykhalov <go.wigust@gmail.com>
Date: Wed, 21 Nov 2018 16:47:43 +0300
Subject: [PATCH] describe: Add json format.

* guix/scripts/describe.scm (channel->json): New procedure.
(display-checkout-info, display-profile-info): Use this.
(%options): Add 'json' option.
* doc/guix.texi (Invoking guix describe): Document this.
---
 doc/guix.texi             |  5 ++++-
 guix/scripts/describe.scm | 19 ++++++++++++++++---
 2 files changed, 20 insertions(+), 4 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 082e81bf7c..3413eb30f2 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -3273,7 +3273,10 @@ produce human-readable output;
 @item channels
 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}).
+guix pull});
+@item json
+@cindex JSON
+produce a list of channel specifications in JSON format.
 @end table
 
 @item --profile=@var{profile}
diff --git a/guix/scripts/describe.scm b/guix/scripts/describe.scm
index 21b4c71526..0bfd983f1b 100644
--- a/guix/scripts/describe.scm
+++ b/guix/scripts/describe.scm
@@ -25,6 +25,7 @@
   #:use-module (guix profiles)
   #:use-module ((guix scripts pull) #:select (display-profile-content))
   #:use-module (git)
+  #:use-module (json)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-37)
   #:use-module (ice-9 match)
@@ -40,7 +41,7 @@
   ;; Specifications of the command-line options.
   (list (option '(#\f "format") #t #f
                 (lambda (opt name arg result)
-                  (unless (member arg '("human" "channels"))
+                  (unless (member arg '("human" "channels" "json"))
                     (leave (G_ "~a: unsupported output format~%") arg))
                   (alist-cons 'format (string->symbol arg) result)))
         (option '(#\p "profile") #t #f
@@ -92,6 +93,11 @@ Display information about the channels currently in use.\n"))
     (url ,(channel-url channel))
     (commit ,(channel-commit channel))))
 
+(define (channel->json channel)
+  (scm->json-string `((name . ,(channel-name channel))
+                      (url . ,(channel-url channel))
+                      (commit . ,(channel-commit channel)))))
+
 (define* (display-checkout-info fmt #:optional directory)
   "Display information about the current checkout according to FMT, a symbol
 denoting the requested format.  Exit if the current directory does not lie
@@ -114,7 +120,12 @@ within a Git checkout."
       ('channels
        (pretty-print `(list ,(channel->sexp (channel (name 'guix)
                                                      (url (dirname directory))
-                                                     (commit commit)))))))
+                                                     (commit commit))))))
+      ('json
+       (display (channel->json (channel (name 'guix)
+                                        (url (dirname directory))
+                                        (commit commit))))
+       (newline)))
     (display-package-search-path fmt)))
 
 (define (display-profile-info profile fmt)
@@ -153,7 +164,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->sexp channels))))
+    ('json
+     (format #t "[~a]~%" (string-join (map channel->json channels) ","))))
   (display-package-search-path fmt))