[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[bug#33448] [PATCH] describe: Add json format.
From: |
Oleg Pykhalov |
Subject: |
[bug#33448] [PATCH] describe: Add json format. |
Date: |
Wed, 21 Nov 2018 10:00:51 +0300 |
* guix/scripts/describe.scm: Add json format.
---
guix/scripts/describe.scm | 69 +++++++++++++++++++++++++--------------
1 file changed, 44 insertions(+), 25 deletions(-)
diff --git a/guix/scripts/describe.scm b/guix/scripts/describe.scm
index d3203e992..53195b423 100644
--- a/guix/scripts/describe.scm
+++ b/guix/scripts/describe.scm
@@ -23,6 +23,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)
@@ -38,7 +39,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 '(#\h "help") #f #f
@@ -101,7 +102,12 @@ within a Git checkout."
(pretty-print `(list (channel
(name 'guix)
(url ,(dirname directory))
- (commit ,commit))))))
+ (commit ,commit)))))
+ ('json
+ (display (scm->json-string `((name . guix)
+ (url . ,(dirname directory))
+ (commit . ,commit))))
+ (newline)))
(display-package-search-path fmt)))
(define (display-profile-info profile fmt)
@@ -110,34 +116,47 @@ in the format specified by FMT."
(define number
(generation-number profile))
+ (define (channels format)
+ (map (lambda (entry)
+ (match (assq 'source (manifest-entry-properties entry))
+ (('source ('repository ('version 0)
+ ('url url)
+ ('branch branch)
+ ('commit commit)
+ _ ...))
+ (case format
+ ((scm)
+ `(channel (name ',(string->symbol
+ (manifest-entry-name entry)))
+ (url ,url)
+ (commit ,commit)))
+ ((json)
+ `((name . ,(string->symbol
+ (manifest-entry-name entry)))
+ (url . ,url)
+ (commit . ,commit)))))
+
+ ;; Pre-0.15.0 Guix does not provide that information,
+ ;; so there's not much we can do in that case.
+ (_ '???)))
+
+ ;; Show most recently installed packages last.
+ (reverse
+ (manifest-entries
+ (profile-manifest
+ (if (zero? number)
+ profile
+ (generation-file-name profile number)))))))
+
(match fmt
('human
(display-profile-content profile number))
('channels
(pretty-print
- `(list ,@(map (lambda (entry)
- (match (assq 'source (manifest-entry-properties entry))
- (('source ('repository ('version 0)
- ('url url)
- ('branch branch)
- ('commit commit)
- _ ...))
- `(channel (name ',(string->symbol
- (manifest-entry-name entry)))
- (url ,url)
- (commit ,commit)))
-
- ;; Pre-0.15.0 Guix does not provide that information,
- ;; so there's not much we can do in that case.
- (_ '???)))
-
- ;; Show most recently installed packages last.
- (reverse
- (manifest-entries
- (profile-manifest
- (if (zero? number)
- profile
- (generation-file-name profile number))))))))))
+ `(list ,@(channels 'scm))))
+ ('json
+ (display (scm->json-string (channels 'json)))
+ (newline)))
(display-package-search-path fmt))
--
2.19.1