[bug#33448,1/3] describe: Use a procedure to format output.

Message ID 20181121141715.16417-1-go.wigust@gmail.com
State Accepted
Headers show
Series [bug#33448,1/3] describe: Use a procedure to format output. | expand

Checks

Context Check Description
cbaines/applying patch success Successfully applied

Commit Message

Oleg Pykhalov Nov. 21, 2018, 2:17 p.m. UTC
* guix/channels.scm (channel->sexp): New procedure.
* guix/scripts/describe.scm (display-checkout-info, display-profile-info): Use
this.
---
 guix/channels.scm         |  9 +++++++
 guix/scripts/describe.scm | 57 ++++++++++++++++++++-------------------
 2 files changed, 38 insertions(+), 28 deletions(-)

Comments

Ludovic Courtès Nov. 21, 2018, 9:31 p.m. UTC | #1
Hi,

Oleg Pykhalov <go.wigust@gmail.com> skribis:

> * guix/channels.scm (channel->sexp): New procedure.
> * guix/scripts/describe.scm (display-checkout-info, display-profile-info): Use
> this.

[...]

> +  (define (channels)

s/define (channels)/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.
> +             (_ '???)))

Maybe return, say: (channel (name 'guix)(url "?")(commit "?")).
This would avoid weird type errors.

> +     (pretty-print (map channel->sexp (channels)))))

I think it should be:

  (pretty-print `(list ,@(map channel->sexp channels)))

right?

OK with these changes, thanks!

Ludo’.
Oleg Pykhalov Nov. 22, 2018, 12:54 p.m. UTC | #2
Hi,

ludo@gnu.org (Ludovic Courtès) writes:

> Oleg Pykhalov <go.wigust@gmail.com> skribis:
>
>> * guix/channels.scm (channel->sexp): New procedure.
>> * guix/scripts/describe.scm (display-checkout-info, display-profile-info): Use
>> this.

[…]

>> +     (pretty-print (map channel->sexp (channels)))))
>
> I think it should be:
>
>   (pretty-print `(list ,@(map channel->sexp channels)))

Ouch, ‘list’ in in 'display-checkout-info' should be too.  Apologies.

Oleg.

Patch

diff --git a/guix/channels.scm b/guix/channels.scm
index 82389eb58..bfdbf470b 100644
--- a/guix/channels.scm
+++ b/guix/channels.scm
@@ -39,6 +39,7 @@ 
             channel-commit
             channel-location
 
+            channel->sexp
             %default-channels
 
             channel-instance?
@@ -85,6 +86,14 @@ 
   "Return true if CHANNEL is the 'guix' channel."
   (eq? 'guix (channel-name channel)))
 
+(define channel->sexp
+  (match-lambda
+    (($ <channel> name url branch commit location)
+     `(channel
+       (name ,name)
+       (url ,url)
+       (commit ,commit)))))
+
 (define-record-type <channel-instance>
   (channel-instance channel commit checkout)
   channel-instance?
diff --git a/guix/scripts/describe.scm b/guix/scripts/describe.scm
index d817d7f7c..6a30d19b1 100644
--- a/guix/scripts/describe.scm
+++ b/guix/scripts/describe.scm
@@ -18,6 +18,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)
@@ -104,10 +105,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 (channel->sexp (channel (name 'guix)
+                                             (url (dirname directory))
+                                             (commit commit))))))
     (display-package-search-path fmt)))
 
 (define (display-profile-info profile fmt)
@@ -116,34 +116,35 @@  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.
+             (_ '???)))
+
+         ;; 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 (map channel->sexp (channels)))))
   (display-package-search-path fmt))