[PATCH] guix package: add a "show" option.

[Cyril Roelandt <tipecaml@gmail.com>]

* guix/packages.scm (package-direct-inputs): New procedure.
* guix/scripts/package.scm: Add a "show" option.
* tests/guix-package.sh: Add a test for the "show" option.
---
 guix/packages.scm        |  8 ++++++++
 guix/scripts/package.scm | 37 +++++++++++++++++++++++++++++++++++++
 tests/guix-package.sh    |  3 +++
 3 files changed, 48 insertions(+)

diff --git a/guix/packages.scm b/guix/packages.scm
index 985a573..4fda77f 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -75,6 +75,7 @@
             package-location
             package-field-location
 
+            package-direct-inputs
             package-transitive-inputs
             package-transitive-target-inputs
             package-transitive-native-inputs
@@ -467,6 +468,13 @@ IMPORTED-MODULES specify modules to use/import for use by SNIPPET."
     ((? string? file)
      (add-to-store store (basename file) #t "sha256" file))))
 
+(define (package-direct-inputs package)
+  (sort (append (package-inputs package)
+                (package-native-inputs package)
+                (package-propagated-inputs package))
+        (lambda (p1 p2)
+          (string<? (car p1) (car p2)))))
+
 (define (transitive-inputs inputs)
   (let loop ((inputs  inputs)
              (result '()))
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index 1c3209f..2b5efc9 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -22,6 +22,7 @@
   #:use-module (guix ui)
   #:use-module (guix store)
   #:use-module (guix derivations)
+  #:use-module (guix licenses)
   #:use-module (guix packages)
   #:use-module (guix profiles)
   #:use-module (guix utils)
@@ -517,6 +518,8 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
   (display (_ "
   -A, --list-available[=REGEXP]
                          list available packages matching REGEXP"))
+  (display (_ "
+  --show=PACKAGE         show details about PACKAGE"))
   (newline)
   (show-build-options-help)
   (newline)
@@ -615,6 +618,11 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
                    (values (cons `(query list-available ,(or arg ""))
                                  result)
                            #f)))
+         (option '("show") #t #t
+                 (lambda (opt name arg result arg-handler)
+                   (values (cons `(query show-package ,arg)
+                                 result)
+                           #f)))
 
          %standard-build-options))
 
@@ -1011,6 +1019,35 @@ more information.~%"))
                       (reverse installed)))
            #t))
 
+        (('show-package requested-name)
+         (let* ((available (fold-packages
+                            (lambda (p r)
+                              (let ((name (package-name p))
+                                    (full-name (package-full-name p)))
+                                (if (or (string=? requested-name name)
+                                        (string=? requested-name full-name))
+                                    (cons p r)
+                                    r)))
+                            '())))
+           (leave-on-EPIPE
+            (for-each (lambda (p)
+                        (format #t "Package: ~a\n\
+Version: ~a\n\
+Description: ~a\n\
+Depends: ~a\n\
+Homepage: ~a\n\
+License: ~a\n~%"
+                                (package-name p)
+                                (package-version p)
+                                (package-description p)
+                                (string-join (map car (package-direct-inputs p)) ", ")
+                                (package-home-page p)
+                                (license-name (package-license p))))
+                      (sort available
+                            (lambda (p1 p2)
+                              (version>? (package-version p2) (package-version p1))))))
+           #t))
+
         (('list-available regexp)
          (let* ((regexp    (and regexp (make-regexp regexp)))
                 (available (fold-packages
diff --git a/tests/guix-package.sh b/tests/guix-package.sh
index 4d75955..d388514 100644
--- a/tests/guix-package.sh
+++ b/tests/guix-package.sh
@@ -176,6 +176,9 @@ then false; else true; fi
 # Check whether `--list-available' returns something sensible.
 guix package -p "$profile" -A 'gui.*e' | grep guile
 
+# Check whether `--show' returns something sensible.
+guix package -p "$profile" --show=guile | grep "^Package: guile"
+
 # There's no generation older than 12 months, so the following command should
 # have no effect.
 generation="`readlink_base "$profile"`"
-- 
1.8.4.rc3