guix-package: Add `--list-installed'.

* guix-package.in (show-help, %options): Add `--list-installed'.
  (guix-package): Move main body to...
  [process-actions]: ... here.  New internal procedure.
  [process-query]: New procedure.
* tests/guix-package.sh: Add tests for `--list-installed'.
* doc/guix.texi (Invoking guix-package): Document it.

doc/guix.texi

@@ -239,7 +239,25 @@ useful to distribution developers.
 
 @end table
 
+In addition to these actions @command{guix-package} supports the
+following options to query the current state of a profile, or the
+availability of packages:
 
+@table @option
+
+@item --list-installed[=@var{regexp}]
+@itemx -I [@var{regexp}]
+List currently installed packages in the specified profile.  When
+@var{regexp} is specified, list only installed packages whose name
+matches @var{regexp}.
+
+For each installed package, print the following items, separated by
+tabs: the package name, its version string, the part of the package that
+is installed (for instance, @code{out} for the default output,
+@code{include} for its headers, etc.), and the path of this package in
+the store.
+
+@end table
 
 
 

guix-package.in

@@ -202,6 +202,10 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
   -b, --bootstrap        use the bootstrap Guile to build the profile"))
   (newline)
   (display (_ "
+  -I, --list-installed[=REGEXP]
+                         list installed packages matching REGEXP"))
+  (newline)
+  (display (_ "
   -h, --help             display this help and exit"))
   (display (_ "
   -V, --version          display version information and exit"))
@@ -234,7 +238,11 @@ Report bugs to: ~a.~%") "@PACKAGE_BUGREPORT@"))
                   (alist-cons 'dry-run? #t result)))
         (option '(#\b "bootstrap") #f #f
                 (lambda (opt name arg result)
-                  (alist-cons 'bootstrap? #t result)))))
+                  (alist-cons 'bootstrap? #t result)))
+        (option '(#\I "list-installed") #f #t
+                (lambda (opt name arg result)
+                  (cons `(query list-installed ,(or arg ""))
+                        result)))))
 
 
 ;;;
@@ -302,19 +310,8 @@ Report bugs to: ~a.~%") "@PACKAGE_BUGREPORT@"))
         (()
          (leave (_ "~a: package not found~%") request)))))
 
-  (setlocale LC_ALL "")
-  (textdomain "guix")
-  (setvbuf (current-output-port) _IOLBF)
-  (setvbuf (current-error-port) _IOLBF)
-
-  (let ((opts (parse-options)))
-    (with-error-handling
-      (parameterize ((%guile-for-build
-                      (package-derivation %store
-                                          (if (assoc-ref opts 'bootstrap?)
-                                              (@@ (distro packages base)
-                                                  %bootstrap-guile)
-                                              guile-2.0))))
+  (define (process-actions opts)
+    ;; Process any install/remove/upgrade action from OPTS.
     (let* ((dry-run? (assoc-ref opts 'dry-run?))
            (profile  (assoc-ref opts 'profile))
            (install  (filter-map (match-lambda
@@ -371,7 +368,41 @@ Report bugs to: ~a.~%") "@PACKAGE_BUGREPORT@"))
                         (symlink prof name)
                         (when (file-exists? profile)
                           (delete-file profile))
-                            (symlink name profile)))))))))))
+                        (symlink name profile))))))))
+
+  (define (process-query opts)
+    ;; Process any query specified by OPTS.  Return #t when a query was
+    ;; actually processed, #f otherwise.
+    (let ((profile  (assoc-ref opts 'profile)))
+      (match (assoc-ref opts 'query)
+        (('list-installed regexp)
+         (let* ((regexp    (and regexp (make-regexp regexp)))
+                (manifest  (profile-manifest profile))
+                (installed (manifest-packages manifest)))
+           (for-each (match-lambda
+                      ((name version output path)
+                       (when (or (not regexp)
+                                 (regexp-exec regexp name))
+                         (format #t "~a\t~a\t~a\t~a~%"
+                                 name (or version "?") output path))))
+                     installed)))
+        (_ #f))))
+
+  (setlocale LC_ALL "")
+  (textdomain "guix")
+  (setvbuf (current-output-port) _IOLBF)
+  (setvbuf (current-error-port) _IOLBF)
+
+  (let ((opts (parse-options)))
+    (with-error-handling
+      (or (process-query opts)
+          (parameterize ((%guile-for-build
+                          (package-derivation %store
+                                              (if (assoc-ref opts 'bootstrap?)
+                                                  (@@ (distro packages base)
+                                                      %bootstrap-guile)
+                                                  guile-2.0))))
+            (process-actions opts))))))
 
 ;; Local Variables:
 ;; eval: (put 'guard 'scheme-indent-function 1)

tests/guix-package.sh

@@ -36,6 +36,20 @@ guix-package -b -p "$profile"						\
 test -L "$profile-2-link"
 test -f "$profile/bin/make" && test -f "$profile/bin/guile"
 
+
+# Check whether `--list-installed' works.
+# XXX: Change the tests when `--install' properly extracts the package
+# name and version string.
+installed="`guix-package -p "$profile" --list-installed | cut -f1 | xargs echo | sort`"
+case "x$installed" in
+    "guile* make*") true;;
+    "make* guile*") true;;
+    "*")            false;;
+esac
+
+test "`guix-package -p "$profile" -I 'g.*e' | cut -f1`" = "guile-bootstrap-2.0"
+
+# Remove a package.
 guix-package -b -p "$profile" -r "guile-bootstrap-2.0"
 test -L "$profile-3-link"
 test -f "$profile/bin/make" && ! test -f "$profile/bin/guile"