diff options
| -rw-r--r-- | doc/guix.texi | 18 | ||||
| -rw-r--r-- | guix-package.in | 159 | ||||
| -rw-r--r-- | tests/guix-package.sh | 14 |
3 files changed, 127 insertions, 64 deletions
diff --git a/doc/guix.texi b/doc/guix.texi index 637265d873..a93510ee23 100644 --- a/doc/guix.texi +++ b/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 diff --git a/guix-package.in b/guix-package.in index b8e9f35d68..ba07eb7c2e 100644 --- a/guix-package.in +++ b/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,6 +310,84 @@ Report bugs to: ~a.~%") "@PACKAGE_BUGREPORT@")) (() (leave (_ "~a: package not found~%") request))))) + (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 + (('install . (? store-path?)) + #f) + (('install . package) + (find-package package)) + (_ #f)) + opts)) + (drv (filter-map (match-lambda + ((name version sub-drv + (? package? package)) + (package-derivation %store package)) + (_ #f)) + install)) + (install* (append + (filter-map (match-lambda + (('install . (? store-path? path)) + `(,(store-path-package-name path) + #f #f ,path)) + (_ #f)) + opts) + (map (lambda (tuple drv) + (match tuple + ((name version sub-drv _) + (let ((output-path + (derivation-path->output-path + drv sub-drv))) + `(,name ,version ,sub-drv ,output-path))))) + install drv))) + (remove (filter-map (match-lambda + (('remove . package) + package) + (_ #f)) + opts)) + (packages (append install* + (fold alist-delete + (manifest-packages + (profile-manifest profile)) + remove)))) + + (show-what-to-build drv dry-run?) + + (or dry-run? + (and (build-derivations %store drv) + (let* ((prof-drv (profile-derivation %store packages)) + (prof (derivation-path->output-path prof-drv)) + (number (latest-profile-number profile)) + (name (format #f "~a/~a-~a-link" + (dirname profile) + (basename profile) (+ 1 number)))) + (and (build-derivations %store (list prof-drv)) + (begin + (symlink prof name) + (when (file-exists? profile) + (delete-file 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) @@ -309,69 +395,14 @@ Report bugs to: ~a.~%") "@PACKAGE_BUGREPORT@")) (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)))) - (let* ((dry-run? (assoc-ref opts 'dry-run?)) - (profile (assoc-ref opts 'profile)) - (install (filter-map (match-lambda - (('install . (? store-path?)) - #f) - (('install . package) - (find-package package)) - (_ #f)) - opts)) - (drv (filter-map (match-lambda - ((name version sub-drv - (? package? package)) - (package-derivation %store package)) - (_ #f)) - install)) - (install* (append - (filter-map (match-lambda - (('install . (? store-path? path)) - `(,(store-path-package-name path) - #f #f ,path)) - (_ #f)) - opts) - (map (lambda (tuple drv) - (match tuple - ((name version sub-drv _) - (let ((output-path - (derivation-path->output-path - drv sub-drv))) - `(,name ,version ,sub-drv ,output-path))))) - install drv))) - (remove (filter-map (match-lambda - (('remove . package) - package) - (_ #f)) - opts)) - (packages (append install* - (fold alist-delete - (manifest-packages - (profile-manifest profile)) - remove)))) - - (show-what-to-build drv dry-run?) - - (or dry-run? - (and (build-derivations %store drv) - (let* ((prof-drv (profile-derivation %store packages)) - (prof (derivation-path->output-path prof-drv)) - (number (latest-profile-number profile)) - (name (format #f "~a/~a-~a-link" - (dirname profile) - (basename profile) (+ 1 number)))) - (and (build-derivations %store (list prof-drv)) - (begin - (symlink prof name) - (when (file-exists? profile) - (delete-file profile)) - (symlink name profile))))))))))) + (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) diff --git a/tests/guix-package.sh b/tests/guix-package.sh index 7363cfc945..6c457ffd4b 100644 --- a/tests/guix-package.sh +++ b/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" |