summaryrefslogtreecommitdiff
path: root/guix/scripts/describe.scm
diff options
context:
space:
mode:
authorOleg Pykhalov <go.wigust@gmail.com>2018-11-21 16:45:08 +0300
committerOleg Pykhalov <go.wigust@gmail.com>2018-11-22 21:17:38 +0300
commit8548f995494d8d6358e6a8d7bc3b3bb5a0cbecb5 (patch)
treeac143256ec3ee26f8328431d5cfaf1335be8a1d4 /guix/scripts/describe.scm
parente3a2dd5559180c3ed28b5be7ca1db49e3b184213 (diff)
describe: Use a procedure to format output.
* guix/scripts/describe.scm (channel->sexp): New procedure. (display-checkout-info, display-profile-info): Use this.
Diffstat (limited to 'guix/scripts/describe.scm')
-rw-r--r--guix/scripts/describe.scm66
1 files changed, 38 insertions, 28 deletions
diff --git a/guix/scripts/describe.scm b/guix/scripts/describe.scm
index d817d7f7ca..21b4c71526 100644
--- a/guix/scripts/describe.scm
+++ b/guix/scripts/describe.scm
@@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -18,6 +19,7 @@
(define-module (guix scripts describe)
#:use-module ((guix ui) #:hide (display-profile-content))
+ #:use-module (guix channels)
#:use-module (guix scripts)
#:use-module (guix describe)
#:use-module (guix profiles)
@@ -84,6 +86,12 @@ Display information about the channels currently in use.\n"))
(format #t (G_ "~%;; warning: GUIX_PACKAGE_PATH=\"~a\"~%")
string))))))
+(define (channel->sexp channel)
+ `(channel
+ (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
@@ -104,10 +112,9 @@ within a Git checkout."
(format #t (G_ " branch: ~a~%") (reference-shorthand head))
(format #t (G_ " commit: ~a~%") commit))
('channels
- (pretty-print `(list (channel
- (name 'guix)
- (url ,(dirname directory))
- (commit ,commit))))))
+ (pretty-print `(list ,(channel->sexp (channel (name 'guix)
+ (url (dirname directory))
+ (commit commit)))))))
(display-package-search-path fmt)))
(define (display-profile-info profile fmt)
@@ -116,34 +123,37 @@ in the format specified by FMT."
(define number
(generation-number profile))
+ (define channels
+ (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.
+ (_ (channel (name 'guix)
+ (url "?")
+ (commit "?")))))
+
+ ;; 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))))))))))
+ (pretty-print `(list ,@(map channel->sexp channels)))))
(display-package-search-path fmt))