summaryrefslogtreecommitdiff
path: root/guix/scripts/package.scm
diff options
context:
space:
mode:
Diffstat (limited to 'guix/scripts/package.scm')
-rw-r--r--guix/scripts/package.scm118
1 files changed, 117 insertions, 1 deletions
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index 6faf2adb7a..8234a1703d 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
;;; Copyright © 2013, 2015 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2014, 2016 Alex Kost <alezost@gmail.com>
@@ -43,11 +43,13 @@
#: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))
#:use-module (ice-9 format)
#:use-module (ice-9 match)
+ #:autoload (ice-9 pretty-print) (pretty-print)
#:use-module (ice-9 regex)
#:use-module (ice-9 vlist)
#:use-module (srfi srfi-1)
@@ -322,6 +324,96 @@ Alternately, see @command{guix package --search-paths -p ~s}.")
;;;
+;;; Export a manifest.
+;;;
+
+(define* (export-manifest manifest
+ #:optional (port (current-output-port)))
+ "Write to PORT a manifest corresponding to MANIFEST."
+ (define (version-spec entry)
+ (let ((name (manifest-entry-name entry)))
+ (match (map package-version (find-packages-by-name name))
+ ((_)
+ ;; A single version of NAME is available, so do not specify the
+ ;; version number, even if the available version doesn't match ENTRY.
+ "")
+ (versions
+ ;; If ENTRY uses the latest version, don't specify any version.
+ ;; Otherwise return the shortest unique version prefix. Note that
+ ;; this is based on the currently available packages, which could
+ ;; differ from the packages available in the revision that was used
+ ;; to build MANIFEST.
+ (let ((current (manifest-entry-version entry)))
+ (if (every (cut version>? current <>)
+ (delete current versions))
+ ""
+ (version-unique-prefix (manifest-entry-version entry)
+ versions)))))))
+
+ (match (manifest->code manifest
+ #:entry-package-version version-spec)
+ (('begin exp ...)
+ (format port (G_ "\
+;; This \"manifest\" file can be passed to 'guix package -m' to reproduce
+;; the content of your profile. This is \"symbolic\": it only specifies
+;; package names. To reproduce the exact same profile, you also need to
+;; capture the channels being used, as returned by \"guix describe\".
+;; See the \"Replicating Guix\" section in the manual.\n"))
+ (for-each (lambda (exp)
+ (newline port)
+ (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.
;;;
@@ -374,6 +466,10 @@ Install, remove, or upgrade packages in a single transaction.\n"))
-S, --switch-generation=PATTERN
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_ "
--list-profiles list the user's profiles"))
@@ -507,6 +603,14 @@ kind of search path~%")
(values (cons `(query search-paths ,kind)
result)
#f))))
+ (option '("export-manifest") #f #f
+ (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)
@@ -827,6 +931,18 @@ processed, #f otherwise."
(format #t "~{~a~%~}" settings)
#t))
+ (('export-manifest)
+ (let* ((manifest (concatenate-manifests
+ (map profile-manifest profiles))))
+ (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))))