From a7c714d3983c746d14b759707ff9e3487d580dd2 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Fri, 16 Aug 2019 14:57:06 +0200
Subject: channels: Add 'profile-channels'.

* guix/channels.scm (profile-channels): New procedure.
* guix/scripts/describe.scm (display-profile-info)[channels]: Define in
terms of 'profile-channels'.
---
 guix/channels.scm         | 28 +++++++++++++++++++++++++++-
 guix/scripts/describe.scm | 27 +++------------------------
 2 files changed, 30 insertions(+), 25 deletions(-)

diff --git a/guix/channels.scm b/guix/channels.scm
index 415246cbd1..ebb2cacbc7 100644
--- a/guix/channels.scm
+++ b/guix/channels.scm
@@ -65,7 +65,9 @@
             latest-channel-derivation
             channel-instances->manifest
             %channel-profile-hooks
-            channel-instances->derivation))
+            channel-instances->derivation
+
+            profile-channels))
 
 ;;; Commentary:
 ;;;
@@ -534,3 +536,27 @@ channel instances."
 latest instances of CHANNELS."
   (mlet %store-monad ((instances (latest-channel-instances* channels)))
     (channel-instances->derivation instances)))
+
+(define (profile-channels profile)
+  "Return the list of channels corresponding to entries in PROFILE.  If
+PROFILE is not a profile created by 'guix pull', return the empty list."
+  (filter-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)))
+
+                  ;; No channel information for this manifest entry.
+                  ;; XXX: Pre-0.15.0 Guix did not provide that information,
+                  ;; but there's not much we can do in that case.
+                  (_ #f)))
+
+              ;; Show most recently installed packages last.
+              (reverse
+               (manifest-entries (profile-manifest profile)))))
diff --git a/guix/scripts/describe.scm b/guix/scripts/describe.scm
index fa6b6cae37..99a88c50fa 100644
--- a/guix/scripts/describe.scm
+++ b/guix/scripts/describe.scm
@@ -153,30 +153,9 @@ in the format specified by FMT."
     (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)))))))
+    (profile-channels (if (zero? number)
+                          profile
+                          (generation-file-name profile number))))
 
   (match fmt
     ('human
-- 
cgit v1.2.3