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.
This commit is contained in:
Ludovic Courtès 2021-01-10 22:13:04 +01:00
parent 60d72f5364
commit aedbc5ff32
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
5 changed files with 121 additions and 2 deletions

View file

@ -43,6 +43,7 @@
#:use-module (guix scripts build)
#:use-module (guix transformations)
#:use-module (guix describe)
#:autoload (guix channels) (channel-name channel-commit channel->code)
#:autoload (guix store roots) (gc-roots user-owned?)
#:use-module ((guix build utils)
#:select (directory-exists? mkdir-p))
@ -363,6 +364,54 @@ Alternately, see @command{guix package --search-paths -p ~s}.")
(pretty-print exp port))
exp))))
(define (channel=? a b)
(and (channel-commit a) (channel-commit b)
(string=? (channel-commit a) (channel-commit b))))
(define* (export-channels manifest
#:optional (port (current-output-port)))
(define channels
(delete-duplicates
(append-map manifest-entry-provenance (manifest-entries manifest))
channel=?))
(define channel-names
(delete-duplicates (map channel-name channels)))
(define table
(fold (lambda (channel table)
(vhash-consq (channel-name channel) channel table))
vlist-null
channels))
(when (null? channels)
(leave (G_ "no provenance information for this profile~%")))
(format port (G_ "\
;; This channel file can be passed to 'guix pull -C' or to
;; 'guix time-machine -C' to obtain the Guix revision that was
;; used to populate this profile.\n"))
(newline port)
(display "(list\n" port)
(for-each (lambda (name)
(define indent " ")
(match (vhash-foldq* cons '() name table)
((channel extra ...)
(unless (null? extra)
(display indent port)
(format port (G_ "\
;; Note: these other commits were also used to install \
some of the packages in this profile:~%"))
(for-each (lambda (channel)
(format port "~a;; ~s~%"
indent (channel-commit channel)))
extra))
(pretty-print (channel->code channel) port
#:per-line-prefix indent))))
channel-names)
(display ")\n" port)
#t)
;;;
;;; Command-line options.
@ -418,6 +467,8 @@ Install, remove, or upgrade packages in a single transaction.\n"))
switch to a generation matching PATTERN"))
(display (G_ "
--export-manifest print a manifest for the chosen profile"))
(display (G_ "
--export-channels print channels for the chosen profile"))
(display (G_ "
-p, --profile=PROFILE use PROFILE instead of the user's default profile"))
(display (G_ "
@ -556,6 +607,10 @@ kind of search path~%")
(lambda (opt name arg result arg-handler)
(values (cons `(query export-manifest) result)
#f)))
(option '("export-channels") #f #f
(lambda (opt name arg result arg-handler)
(values (cons `(query export-channels) result)
#f)))
(option '(#\p "profile") #t #f
(lambda (opt name arg result arg-handler)
(values (alist-cons 'profile (canonicalize-profile arg)
@ -882,6 +937,12 @@ processed, #f otherwise."
(export-manifest manifest (current-output-port))
#t))
(('export-channels)
(let ((manifest (concatenate-manifests
(map profile-manifest profiles))))
(export-channels manifest (current-output-port))
#t))
(_ #f))))