From mboxrd@z Thu Jan  1 00:00:00 1970
From: Cyril Roelandt <tipecaml@gmail.com>
Subject: [PATCH] guix package: add a "show" option.
Date: Sun, 13 Jul 2014 20:54:01 +0200
Message-ID: <1405277641-2891-1-git-send-email-tipecaml@gmail.com>
Return-path: <guix-devel-bounces+gcggd-guix-devel=m.gmane.org@gnu.org>
Received: from eggs.gnu.org ([2001:4830:134:3::10]:51975)
	by lists.gnu.org with esmtp (Exim 4.71)
	(envelope-from <tipecaml@gmail.com>) id 1X6P3K-00056D-Ae
	for guix-devel@gnu.org; Sun, 13 Jul 2014 15:03:21 -0400
Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71)
	(envelope-from <tipecaml@gmail.com>) id 1X6P3D-0005nc-Au
	for guix-devel@gnu.org; Sun, 13 Jul 2014 15:03:14 -0400
Received: from mail-wg0-x22f.google.com ([2a00:1450:400c:c00::22f]:51028)
	by eggs.gnu.org with esmtp (Exim 4.71)
	(envelope-from <tipecaml@gmail.com>) id 1X6P3D-0005mj-08
	for guix-devel@gnu.org; Sun, 13 Jul 2014 15:03:07 -0400
Received: by mail-wg0-f47.google.com with SMTP id b13so1081915wgh.6
	for <guix-devel@gnu.org>; Sun, 13 Jul 2014 12:03:06 -0700 (PDT)
List-Id: "Development of GNU Guix and the GNU System distribution."
	<guix-devel.gnu.org>
List-Unsubscribe: <https://lists.gnu.org/mailman/options/guix-devel>,
	<mailto:guix-devel-request@gnu.org?subject=unsubscribe>
List-Archive: <http://lists.gnu.org/archive/html/guix-devel>
List-Post: <mailto:guix-devel@gnu.org>
List-Help: <mailto:guix-devel-request@gnu.org?subject=help>
List-Subscribe: <https://lists.gnu.org/mailman/listinfo/guix-devel>,
	<mailto:guix-devel-request@gnu.org?subject=subscribe>
Errors-To: guix-devel-bounces+gcggd-guix-devel=m.gmane.org@gnu.org
Sender: guix-devel-bounces+gcggd-guix-devel=m.gmane.org@gnu.org
To: guix-devel@gnu.org

* 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