summary refs log tree commit diff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2019-08-16 14:57:06 +0200
committerLudovic Courtès <ludo@gnu.org>2019-08-16 23:00:26 +0200
commita7c714d3983c746d14b759707ff9e3487d580dd2 (patch)
tree5355b5a1d50eefe0119a0f0d078f5d505f9561e1
parentb65bd33c36dcc290193a419b34ad4d4a7b3ff14d (diff)
downloadguix-a7c714d3983c746d14b759707ff9e3487d580dd2.tar.gz
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'.
-rw-r--r--guix/channels.scm28
-rw-r--r--guix/scripts/describe.scm27
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