From 8548f995494d8d6358e6a8d7bc3b3bb5a0cbecb5 Mon Sep 17 00:00:00 2001
From: Oleg Pykhalov <go.wigust@gmail.com>
Date: Wed, 21 Nov 2018 16:45:08 +0300
Subject: describe: Use a procedure to format output.

* guix/scripts/describe.scm (channel->sexp): New procedure.
(display-checkout-info, display-profile-info): Use this.
---
 guix/scripts/describe.scm | 66 +++++++++++++++++++++++++++--------------------
 1 file changed, 38 insertions(+), 28 deletions(-)

(limited to 'guix')

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