summary refs log tree commit diff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2013-11-01 16:31:45 +0100
committerLudovic Courtès <ludo@gnu.org>2013-11-01 23:21:00 +0100
commitcc4ecc2d8869081483feaf47bdcb4a740c7c67f8 (patch)
tree118665502886f868e9a54e9d559cd28ebc13eebe
parentfdd6c72683655acf6b6e9f195c533ee7feddfbc8 (diff)
downloadguix-cc4ecc2d8869081483feaf47bdcb4a740c7c67f8.tar.gz
Add (guix profiles).
* guix/scripts/package.scm (show-what-to-remove/install): New procedure,
  moved from...
  (guix-package): ... here.
  (<manifest>, make-manifest, <manifest-entry>,
  profile-manifest, manifest->sexp, sexp->manifest, read-manifest,
  write-manifest, remove-manifest-entry, manifest-remove,
  manifest-installed?, manifest=?, profile-regexp, generation-numbers,
  previous-generation-number, profile-derivation, generation-number,
  generation-file-name, generation-time, lower-input): Move to...
* guix/profiles.scm: ... here.  New file.
* Makefile.am (MODULES): Add it.
-rw-r--r--Makefile.am1
-rw-r--r--guix/profiles.scm315
-rw-r--r--guix/scripts/package.scm343
3 files changed, 362 insertions, 297 deletions
diff --git a/Makefile.am b/Makefile.am
index 7a74bc8601..1960b1b76d 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -41,6 +41,7 @@ MODULES =					\
   guix/hash.scm					\
   guix/utils.scm				\
   guix/monads.scm				\
+  guix/profiles.scm				\
   guix/serialization.scm			\
   guix/nar.scm					\
   guix/derivations.scm				\
diff --git a/guix/profiles.scm b/guix/profiles.scm
new file mode 100644
index 0000000000..528f3c574b
--- /dev/null
+++ b/guix/profiles.scm
@@ -0,0 +1,315 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guix profiles)
+  #:use-module (guix utils)
+  #:use-module (guix records)
+  #:use-module (guix derivations)
+  #:use-module (guix packages)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 regex)
+  #:use-module (ice-9 ftw)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-9)
+  #:use-module (srfi srfi-19)
+  #:use-module (srfi srfi-26)
+  #:export (manifest make-manifest
+            manifest?
+            manifest-entries
+
+            <manifest-entry>              ; FIXME: eventually make it internal
+            manifest-entry
+            manifest-entry?
+            manifest-entry-name
+            manifest-entry-version
+            manifest-entry-output
+            manifest-entry-path
+            manifest-entry-dependencies
+
+            read-manifest
+            write-manifest
+
+            manifest-remove
+            manifest-installed?
+            manifest=?
+
+            profile-manifest
+            profile-derivation
+            generation-number
+            generation-numbers
+            previous-generation-number
+            generation-time
+            generation-file-name))
+
+;;; Commentary:
+;;;
+;;; Tools to create and manipulate profiles---i.e., the representation of a
+;;; set of installed packages.
+;;;
+;;; Code:
+
+
+;;;
+;;; Manifests.
+;;;
+
+(define-record-type <manifest>
+  (manifest entries)
+  manifest?
+  (entries manifest-entries))                     ; list of <manifest-entry>
+
+;; Convenient alias, to avoid name clashes.
+(define make-manifest manifest)
+
+(define-record-type* <manifest-entry> manifest-entry
+  make-manifest-entry
+  manifest-entry?
+  (name         manifest-entry-name)              ; string
+  (version      manifest-entry-version)           ; string
+  (output       manifest-entry-output             ; string
+                (default "out"))
+  (path         manifest-entry-path)              ; store path
+  (dependencies manifest-entry-dependencies       ; list of store paths
+                (default '()))
+  (inputs       manifest-entry-inputs             ; list of inputs to build
+                (default '())))                   ; this entry
+
+(define (profile-manifest profile)
+  "Return the PROFILE's manifest."
+  (let ((file (string-append profile "/manifest")))
+    (if (file-exists? file)
+        (call-with-input-file file read-manifest)
+        (manifest '()))))
+
+(define (manifest->sexp manifest)
+  "Return a representation of MANIFEST as an sexp."
+  (define (entry->sexp entry)
+    (match entry
+      (($ <manifest-entry> name version path output (deps ...))
+       (list name version path output deps))))
+
+  (match manifest
+    (($ <manifest> (entries ...))
+     `(manifest (version 1)
+                (packages ,(map entry->sexp entries))))))
+
+(define (sexp->manifest sexp)
+  "Parse SEXP as a manifest."
+  (match sexp
+    (('manifest ('version 0)
+                ('packages ((name version output path) ...)))
+     (manifest
+      (map (lambda (name version output path)
+             (manifest-entry
+              (name name)
+              (version version)
+              (output output)
+              (path path)))
+           name version output path)))
+
+    ;; Version 1 adds a list of propagated inputs to the
+    ;; name/version/output/path tuples.
+    (('manifest ('version 1)
+                ('packages ((name version output path deps) ...)))
+     (manifest
+      (map (lambda (name version output path deps)
+             (manifest-entry
+              (name name)
+              (version version)
+              (output output)
+              (path path)
+              (dependencies deps)))
+           name version output path deps)))
+
+    (_
+     (error "unsupported manifest format" manifest))))
+
+(define (read-manifest port)
+  "Return the packages listed in MANIFEST."
+  (sexp->manifest (read port)))
+
+(define (write-manifest manifest port)
+  "Write MANIFEST to PORT."
+  (write (manifest->sexp manifest) port))
+
+(define (remove-manifest-entry name lst)
+  "Remove the manifest entry named NAME from LST."
+  (remove (match-lambda
+           (($ <manifest-entry> entry-name)
+            (string=? name entry-name)))
+          lst))
+
+(define (manifest-remove manifest names)
+  "Remove entries for each of NAMES from MANIFEST."
+  (make-manifest (fold remove-manifest-entry
+                       (manifest-entries manifest)
+                       names)))
+
+(define (manifest-installed? manifest name)
+  "Return #t if MANIFEST has an entry for NAME, #f otherwise."
+  (define (->bool x)
+    (not (not x)))
+
+  (->bool (find (match-lambda
+                 (($ <manifest-entry> entry-name)
+                  (string=? entry-name name)))
+                (manifest-entries manifest))))
+
+(define (manifest=? m1 m2)
+  "Return #t if manifests M1 and M2 are equal.  This differs from 'equal?' in
+that the 'inputs' field is ignored for the comparison, since it is know to
+have no effect on the manifest contents."
+  (equal? (manifest->sexp m1)
+          (manifest->sexp m2)))
+
+
+;;;
+;;; Profiles.
+;;;
+
+(define* (lower-input store input #:optional (system (%current-system)))
+  "Lower INPUT so that it contains derivations instead of packages."
+  (match input
+    ((name (? package? package))
+     `(,name ,(package-derivation store package system)))
+    ((name (? package? package) output)
+     `(,name ,(package-derivation store package system)
+             ,output))
+    (_ input)))
+
+(define (profile-derivation store manifest)
+  "Return a derivation that builds a profile (aka. 'user environment') with
+the given MANIFEST."
+  (define builder
+    `(begin
+       (use-modules (ice-9 pretty-print)
+                    (guix build union))
+
+       (setvbuf (current-output-port) _IOLBF)
+       (setvbuf (current-error-port) _IOLBF)
+
+       (let ((output (assoc-ref %outputs "out"))
+             (inputs (map cdr %build-inputs)))
+         (format #t "building profile '~a' with ~a packages...~%"
+                 output (length inputs))
+         (union-build output inputs
+                      #:log-port (%make-void-port "w"))
+         (call-with-output-file (string-append output "/manifest")
+           (lambda (p)
+             (pretty-print ',(manifest->sexp manifest) p))))))
+
+  (build-expression->derivation store "profile"
+                                (%current-system)
+                                builder
+                                (append-map (match-lambda
+                                             (($ <manifest-entry> name version
+                                                 output path deps (inputs ..1))
+                                              (map (cute lower-input store <>)
+                                                   inputs))
+                                             (($ <manifest-entry> name version
+                                                 output path deps)
+                                              ;; Assume PATH and DEPS are
+                                              ;; already valid.
+                                              `((,name ,path) ,@deps)))
+                                            (manifest-entries manifest))
+                                #:modules '((guix build union))))
+
+(define (profile-regexp profile)
+  "Return a regular expression that matches PROFILE's name and number."
+  (make-regexp (string-append "^" (regexp-quote (basename profile))
+                              "-([0-9]+)")))
+
+(define (generation-number profile)
+  "Return PROFILE's number or 0.  An absolute file name must be used."
+  (or (and=> (false-if-exception (regexp-exec (profile-regexp profile)
+                                              (basename (readlink profile))))
+             (compose string->number (cut match:substring <> 1)))
+      0))
+
+(define (generation-numbers profile)
+  "Return the sorted list of generation numbers of PROFILE, or '(0) if no
+former profiles were found."
+  (define* (scandir name #:optional (select? (const #t))
+                    (entry<? (@ (ice-9 i18n) string-locale<?)))
+    ;; XXX: Bug-fix version introduced in Guile v2.0.6-62-g139ce19.
+    (define (enter? dir stat result)
+      (and stat (string=? dir name)))
+
+    (define (visit basename result)
+      (if (select? basename)
+          (cons basename result)
+          result))
+
+    (define (leaf name stat result)
+      (and result
+           (visit (basename name) result)))
+
+    (define (down name stat result)
+      (visit "." '()))
+
+    (define (up name stat result)
+      (visit ".." result))
+
+    (define (skip name stat result)
+      ;; All the sub-directories are skipped.
+      (visit (basename name) result))
+
+    (define (error name* stat errno result)
+      (if (string=? name name*)             ; top-level NAME is unreadable
+          result
+          (visit (basename name*) result)))
+
+    (and=> (file-system-fold enter? leaf down up skip error #f name lstat)
+           (lambda (files)
+             (sort files entry<?))))
+
+  (match (scandir (dirname profile)
+                  (cute regexp-exec (profile-regexp profile) <>))
+    (#f                                         ; no profile directory
+     '(0))
+    (()                                         ; no profiles
+     '(0))
+    ((profiles ...)                             ; former profiles around
+     (sort (map (compose string->number
+                         (cut match:substring <> 1)
+                         (cute regexp-exec (profile-regexp profile) <>))
+                profiles)
+           <))))
+
+(define (previous-generation-number profile number)
+  "Return the number of the generation before generation NUMBER of
+PROFILE, or 0 if none exists.  It could be NUMBER - 1, but it's not the
+case when generations have been deleted (there are \"holes\")."
+  (fold (lambda (candidate highest)
+          (if (and (< candidate number) (> candidate highest))
+              candidate
+              highest))
+        0
+        (generation-numbers profile)))
+
+(define (generation-file-name profile generation)
+  "Return the file name for PROFILE's GENERATION."
+  (format #f "~a-~a-link" profile generation))
+
+(define (generation-time profile number)
+  "Return the creation time of a generation in the UTC format."
+  (make-time time-utc 0
+             (stat:ctime (stat (generation-file-name profile number)))))
+
+;;; profiles.scm ends here
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index 008ae53b47..4dbe2b7b63 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -23,22 +23,19 @@
   #:use-module (guix store)
   #:use-module (guix derivations)
   #:use-module (guix packages)
+  #:use-module (guix profiles)
   #:use-module (guix utils)
   #:use-module (guix config)
-  #:use-module (guix records)
   #:use-module ((guix build utils) #:select (directory-exists? mkdir-p))
   #:use-module ((guix ftp-client) #:select (ftp-open))
-  #:use-module (ice-9 ftw)
   #:use-module (ice-9 format)
   #:use-module (ice-9 match)
   #:use-module (ice-9 regex)
   #:use-module (ice-9 vlist)
   #:use-module (srfi srfi-1)
-  #:use-module (srfi srfi-9)
   #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-19)
   #:use-module (srfi srfi-26)
-  #:use-module (srfi srfi-34)
   #:use-module (srfi srfi-37)
   #:use-module (gnu packages)
   #:use-module ((gnu packages base) #:select (guile-final))
@@ -51,7 +48,7 @@
 
 
 ;;;
-;;; User profile.
+;;; Profiles.
 ;;;
 
 (define %user-profile-directory
@@ -69,240 +66,6 @@
   ;; coexist with Nix profiles.
   (string-append %profile-directory "/guix-profile"))
 
-
-;;;
-;;; Manifests.
-;;;
-
-(define-record-type <manifest>
-  (manifest entries)
-  manifest?
-  (entries manifest-entries))                     ; list of <manifest-entry>
-
-;; Convenient alias, to avoid name clashes.
-(define make-manifest manifest)
-
-(define-record-type* <manifest-entry> manifest-entry
-  make-manifest-entry
-  manifest-entry?
-  (name         manifest-entry-name)              ; string
-  (version      manifest-entry-version)           ; string
-  (output       manifest-entry-output             ; string
-                (default "out"))
-  (path         manifest-entry-path)              ; store path
-  (dependencies manifest-entry-dependencies       ; list of store paths
-                (default '()))
-  (inputs       manifest-entry-inputs             ; list of inputs to build
-                (default '())))                   ; this entry
-
-(define (profile-manifest profile)
-  "Return the PROFILE's manifest."
-  (let ((file (string-append profile "/manifest")))
-    (if (file-exists? file)
-        (call-with-input-file file read-manifest)
-        (manifest '()))))
-
-(define (manifest->sexp manifest)
-  "Return a representation of MANIFEST as an sexp."
-  (define (entry->sexp entry)
-    (match entry
-      (($ <manifest-entry> name version path output (deps ...))
-       (list name version path output deps))))
-
-  (match manifest
-    (($ <manifest> (entries ...))
-     `(manifest (version 1)
-                (packages ,(map entry->sexp entries))))))
-
-(define (sexp->manifest sexp)
-  "Parse SEXP as a manifest."
-  (match sexp
-    (('manifest ('version 0)
-                ('packages ((name version output path) ...)))
-     (manifest
-      (map (lambda (name version output path)
-             (manifest-entry
-              (name name)
-              (version version)
-              (output output)
-              (path path)))
-           name version output path)))
-
-    ;; Version 1 adds a list of propagated inputs to the
-    ;; name/version/output/path tuples.
-    (('manifest ('version 1)
-                ('packages ((name version output path deps) ...)))
-     (manifest
-      (map (lambda (name version output path deps)
-             (manifest-entry
-              (name name)
-              (version version)
-              (output output)
-              (path path)
-              (dependencies deps)))
-           name version output path deps)))
-
-    (_
-     (error "unsupported manifest format" manifest))))
-
-(define (read-manifest port)
-  "Return the packages listed in MANIFEST."
-  (sexp->manifest (read port)))
-
-(define (write-manifest manifest port)
-  "Write MANIFEST to PORT."
-  (write (manifest->sexp manifest) port))
-
-(define (remove-manifest-entry name lst)
-  "Remove the manifest entry named NAME from LST."
-  (remove (match-lambda
-           (($ <manifest-entry> entry-name)
-            (string=? name entry-name)))
-          lst))
-
-(define (manifest-remove manifest names)
-  "Remove entries for each of NAMES from MANIFEST."
-  (make-manifest (fold remove-manifest-entry
-                       (manifest-entries manifest)
-                       names)))
-
-(define (manifest-installed? manifest name)
-  "Return #t if MANIFEST has an entry for NAME, #f otherwise."
-  (define (->bool x)
-    (not (not x)))
-
-  (->bool (find (match-lambda
-                 (($ <manifest-entry> entry-name)
-                  (string=? entry-name name)))
-                (manifest-entries manifest))))
-
-(define (manifest=? m1 m2)
-  "Return #t if manifests M1 and M2 are equal.  This differs from 'equal?' in
-that the 'inputs' field is ignored for the comparison, since it is know to
-have no effect on the manifest contents."
-  (equal? (manifest->sexp m1)
-          (manifest->sexp m2)))
-
-
-;;;
-;;; Profiles.
-;;;
-
-(define (profile-regexp profile)
-  "Return a regular expression that matches PROFILE's name and number."
-  (make-regexp (string-append "^" (regexp-quote (basename profile))
-                              "-([0-9]+)")))
-
-(define (generation-numbers profile)
-  "Return the sorted list of generation numbers of PROFILE, or '(0) if no
-former profiles were found."
-  (define* (scandir name #:optional (select? (const #t))
-                    (entry<? (@ (ice-9 i18n) string-locale<?)))
-    ;; XXX: Bug-fix version introduced in Guile v2.0.6-62-g139ce19.
-    (define (enter? dir stat result)
-      (and stat (string=? dir name)))
-
-    (define (visit basename result)
-      (if (select? basename)
-          (cons basename result)
-          result))
-
-    (define (leaf name stat result)
-      (and result
-           (visit (basename name) result)))
-
-    (define (down name stat result)
-      (visit "." '()))
-
-    (define (up name stat result)
-      (visit ".." result))
-
-    (define (skip name stat result)
-      ;; All the sub-directories are skipped.
-      (visit (basename name) result))
-
-    (define (error name* stat errno result)
-      (if (string=? name name*)             ; top-level NAME is unreadable
-          result
-          (visit (basename name*) result)))
-
-    (and=> (file-system-fold enter? leaf down up skip error #f name lstat)
-           (lambda (files)
-             (sort files entry<?))))
-
-  (match (scandir (dirname profile)
-                  (cute regexp-exec (profile-regexp profile) <>))
-    (#f                                         ; no profile directory
-     '(0))
-    (()                                         ; no profiles
-     '(0))
-    ((profiles ...)                             ; former profiles around
-     (sort (map (compose string->number
-                         (cut match:substring <> 1)
-                         (cute regexp-exec (profile-regexp profile) <>))
-                profiles)
-           <))))
-
-(define (previous-generation-number profile number)
-  "Return the number of the generation before generation NUMBER of
-PROFILE, or 0 if none exists.  It could be NUMBER - 1, but it's not the
-case when generations have been deleted (there are \"holes\")."
-  (fold (lambda (candidate highest)
-          (if (and (< candidate number) (> candidate highest))
-              candidate
-              highest))
-        0
-        (generation-numbers profile)))
-
-(define (profile-derivation store manifest)
-  "Return a derivation that builds a profile (aka. 'user environment') with
-the given MANIFEST."
-  (define builder
-    `(begin
-       (use-modules (ice-9 pretty-print)
-                    (guix build union))
-
-       (setvbuf (current-output-port) _IOLBF)
-       (setvbuf (current-error-port) _IOLBF)
-
-       (let ((output (assoc-ref %outputs "out"))
-             (inputs (map cdr %build-inputs)))
-         (format #t "building profile '~a' with ~a packages...~%"
-                 output (length inputs))
-         (union-build output inputs
-                      #:log-port (%make-void-port "w"))
-         (call-with-output-file (string-append output "/manifest")
-           (lambda (p)
-             (pretty-print ',(manifest->sexp manifest) p))))))
-
-  (build-expression->derivation store "profile"
-                                (%current-system)
-                                builder
-                                (append-map (match-lambda
-                                             (($ <manifest-entry> name version
-                                                 output path deps (inputs ..1))
-                                              (map (cute lower-input
-                                                         (%store) <>)
-                                                   inputs))
-                                             (($ <manifest-entry> name version
-                                                 output path deps)
-                                              ;; Assume PATH and DEPS are
-                                              ;; already valid.
-                                              `((,name ,path) ,@deps)))
-                                            (manifest-entries manifest))
-                                #:modules '((guix build union))))
-
-(define (generation-number profile)
-  "Return PROFILE's number or 0.  An absolute file name must be used."
-  (or (and=> (false-if-exception (regexp-exec (profile-regexp profile)
-                                              (basename (readlink profile))))
-             (compose string->number (cut match:substring <> 1)))
-      0))
-
-(define (generation-file-name profile generation)
-  "Return the file name for PROFILE's GENERATION."
-  (format #f "~a-~a-link" profile generation))
-
 (define (link-to-empty-profile generation)
   "Link GENERATION, a string, to the empty profile."
   (let* ((drv  (profile-derivation (%store) (manifest '())))
@@ -340,11 +103,6 @@ the given MANIFEST."
           (else
            (switch-to-previous-generation profile)))))  ; anything else
 
-(define (generation-time profile number)
-  "Return the creation time of a generation in the UTC format."
-  (make-time time-utc 0
-             (stat:ctime (stat (generation-file-name profile number)))))
-
 (define* (matching-generations str #:optional (profile %current-profile)
                                #:key (duration-relation <=))
   "Return the list of available generations matching a pattern in STR.  See
@@ -411,6 +169,50 @@ DURATION-RELATION with the current time."
          filter-by-duration)
         (else #f)))
 
+(define (show-what-to-remove/install remove install dry-run?)
+  "Given the manifest entries listed in REMOVE and INSTALL, display the
+packages that will/would be installed and removed."
+  ;; TODO: Report upgrades more clearly.
+  (match remove
+    ((($ <manifest-entry> name version _ path _) ..1)
+     (let ((len    (length name))
+           (remove (map (cut format #f "  ~a-~a\t~a" <> <> <>)
+                        name version path)))
+       (if dry-run?
+           (format (current-error-port)
+                   (N_ "The following package would be removed:~% ~{~a~%~}~%"
+                       "The following packages would be removed:~% ~{~a~%~}~%"
+                       len)
+                   remove)
+           (format (current-error-port)
+                   (N_ "The following package will be removed:~% ~{~a~%~}~%"
+                       "The following packages will be removed:~% ~{~a~%~}~%"
+                       len)
+                   remove))))
+    (_ #f))
+  (match install
+    ((($ <manifest-entry> name version output path _) ..1)
+     (let ((len     (length name))
+           (install (map (cut format #f "   ~a-~a\t~a\t~a" <> <> <> <>)
+                         name version output path)))
+       (if dry-run?
+           (format (current-error-port)
+                   (N_ "The following package would be installed:~%~{~a~%~}~%"
+                       "The following packages would be installed:~%~{~a~%~}~%"
+                       len)
+                   install)
+           (format (current-error-port)
+                   (N_ "The following package will be installed:~%~{~a~%~}~%"
+                       "The following packages will be installed:~%~{~a~%~}~%"
+                       len)
+                   install))))
+    (_ #f)))
+
+
+;;;
+;;; Package specifications.
+;;;
+
 (define (find-packages-by-description rx)
   "Return the list of packages whose name, synopsis, or description matches
 RX."
@@ -437,16 +239,6 @@ RX."
                 (package-name p2))))
    same-location?))
 
-(define* (lower-input store input #:optional (system (%current-system)))
-  "Lower INPUT so that it contains derivations instead of packages."
-  (match input
-    ((name (? package? package))
-     `(,name ,(package-derivation store package system)))
-    ((name (? package? package) output)
-     `(,name ,(package-derivation store package system)
-             ,output))
-    (_ input)))
-
 (define (input->name+path input)
   "Convert the name/package/sub-drv tuple INPUT to a name/store-path tuple."
   (let loop ((input input))
@@ -500,11 +292,6 @@ return its return value."
        (format (current-error-port) "  interrupted by signal ~a~%" SIGINT)
        #f))))
 
-
-;;;
-;;; Package specifications.
-;;;
-
 (define newest-available-packages
   (memoize find-newest-available-packages))
 
@@ -989,44 +776,6 @@ more information.~%"))
          (and (equal? name entry-name)
               (equal? output entry-output)))))
 
-    (define (show-what-to-remove/install remove install dry-run?)
-      ;; Tell the user what's going to happen in high-level terms.
-      ;; TODO: Report upgrades more clearly.
-      (match remove
-        ((($ <manifest-entry> name version _ path _) ..1)
-         (let ((len    (length name))
-               (remove (map (cut format #f "  ~a-~a\t~a" <> <> <>)
-                            name version path)))
-           (if dry-run?
-               (format (current-error-port)
-                       (N_ "The following package would be removed:~% ~{~a~%~}~%"
-                           "The following packages would be removed:~% ~{~a~%~}~%"
-                           len)
-                       remove)
-               (format (current-error-port)
-                       (N_ "The following package will be removed:~% ~{~a~%~}~%"
-                           "The following packages will be removed:~% ~{~a~%~}~%"
-                           len)
-                       remove))))
-        (_ #f))
-      (match install
-        ((($ <manifest-entry> name version output path _) ..1)
-         (let ((len     (length name))
-               (install (map (cut format #f "   ~a-~a\t~a\t~a" <> <> <> <>)
-                             name version output path)))
-           (if dry-run?
-               (format (current-error-port)
-                       (N_ "The following package would be installed:~%~{~a~%~}~%"
-                           "The following packages would be installed:~%~{~a~%~}~%"
-                           len)
-                       install)
-               (format (current-error-port)
-                       (N_ "The following package will be installed:~%~{~a~%~}~%"
-                           "The following packages will be installed:~%~{~a~%~}~%"
-                           len)
-                       install))))
-        (_ #f)))
-
     (define current-generation-number
       (generation-number profile))