From aedbc5ff32a62f45aeed74c6833399a6cf2c22dc Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Sun, 10 Jan 2021 22:13:04 +0100
Subject: guix package: Add '--export-channels'.

* guix/channels.scm (sexp->channel): Export.
* guix/describe.scm: Use (guix channels).
(manifest-entry-provenance): New procedure.
* guix/scripts/package.scm (channel=?, export-channels): New
procedures.
(show-help, %options): Add '--export-channels'.
(process-query): Honor it.
* build-aux/build-self.scm (build-program)[select?]: Exclude (guix
channels) to account for the (guix describe) change above.
* doc/guix.texi (Invoking guix package): Document it.
---
 guix/describe.scm | 34 ++++++++++++++++++++++++++++++++--
 1 file changed, 32 insertions(+), 2 deletions(-)

(limited to 'guix/describe.scm')

diff --git a/guix/describe.scm b/guix/describe.scm
index 05bf99eb58..ac89fc0d7c 100644
--- a/guix/describe.scm
+++ b/guix/describe.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -23,6 +23,7 @@
   #:use-module ((guix utils) #:select (location-file))
   #:use-module ((guix store) #:select (%store-prefix store-path?))
   #:use-module ((guix config) #:select (%state-directory))
+  #:autoload   (guix channels) (sexp->channel)
   #:use-module (srfi srfi-1)
   #:use-module (ice-9 match)
   #:export (current-profile
@@ -31,7 +32,8 @@
             package-path-entries
 
             package-provenance
-            manifest-entry-with-provenance))
+            manifest-entry-with-provenance
+            manifest-entry-provenance))
 
 ;;; Commentary:
 ;;;
@@ -166,3 +168,31 @@ there."
                (#f   properties)
                (sexp `((provenance ,@sexp)
                        ,@properties)))))))))
+
+(define (manifest-entry-provenance entry)
+  "Return the list of channels ENTRY comes from.  Return the empty list if
+that information is missing."
+  (match (assq-ref (manifest-entry-properties entry) 'provenance)
+    ((main extras ...)
+     ;; XXX: Until recently, channel sexps lacked the channel name.  For
+     ;; entries created by 'manifest-entry-with-provenance', the first sexp
+     ;; is known to be the 'guix channel, and for the other ones, invent a
+     ;; fallback name (it's OK as the name is just a "pet name").
+     (match (sexp->channel main 'guix)
+       (#f '())
+       (channel
+        (let loop ((extras   extras)
+                   (counter  1)
+                   (channels (list channel)))
+          (match extras
+            (()
+             (reverse channels))
+            ((head . tail)
+             (let* ((name  (string->symbol
+                            (format #f "channel~a" counter)))
+                    (extra (sexp->channel head name)))
+               (if extra
+                   (loop tail (+ 1 counter) (cons extra channels))
+                   (loop tail counter channels)))))))))
+    (_
+     '())))
-- 
cgit v1.2.3