[PATCH] guix-package: Add '--search'. (was: guix-package --search)

[Nikita Karetnikov <nikita@karetnikov.org>]

[-- Attachment #1.1: Type: text/plain, Size: 228 bytes --]

>    (if (or (and=> (package-synopsis package)
>                   (compose matches? gettext))

I came up with a different solution, which seems more readable.  What
do you think?  (If you want, I'll use your version.)

Nikita


[-- Attachment #1.2: 0001-guix-package-Add-search.patch --]
[-- Type: text/x-diff, Size: 5709 bytes --]

From 0083eff18eb584213f55974807d4e0e6e29d3c73 Mon Sep 17 00:00:00 2001
From: Nikita Karetnikov <nikita@karetnikov.org>
Date: Sat, 26 Jan 2013 08:36:31 +0000
Subject: [PATCH] guix-package: Add '--search'.

* guix-package.in (find-packages-by-description): New procedure.
  (show-help, %options): Add '--search'.
  (guix-package)[process-query]: Add support for '--search'.
* doc/guix.texi (Invoking guix-package): Document it.
* tests/guix-package.sh: Add tests.
---
 doc/guix.texi         |    9 +++++++++
 guix-package.in       |   39 +++++++++++++++++++++++++++++++++++++++
 tests/guix-package.sh |    9 +++++++++
 3 files changed, 57 insertions(+), 0 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index e1ca095..01c60ae 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -23,6 +23,7 @@
 @title{GNU Guix Reference Manual}
 @subtitle{Using the GNU Guix Functional Package Manager}
 @author Ludovic Courtès
+@author Nikita Karetnikov
 
 @page
 @vskip 0pt plus 1filll
@@ -533,6 +534,14 @@ availability of packages:
 
 @table @option
 
+@item --search=@var{regexp}
+@itemx -s @var{regexp}
+Search in the @emph{synopsis} and @emph{description} fields of the
+available packages.  And list the ones that match @var{regexp}.
+
+For each package, print the following items, separated by tabs: its
+name, version, and the source location of its definition.
+
 @item --list-installed[=@var{regexp}]
 @itemx -I [@var{regexp}]
 List currently installed packages in the specified profile.  When
diff --git a/guix-package.in b/guix-package.in
index 37a1df0..b88928a 100644
--- a/guix-package.in
+++ b/guix-package.in
@@ -229,6 +229,28 @@ all of PACKAGES, a list of name/version/output/path tuples."
            (leave (_ "error: no previous profile; not rolling back~%")))
           (else (switch-link)))))
 
+(define (find-packages-by-description rx)
+  "Search in SYNOPSIS and DESCRIPTION using RX.  Return a list of
+matching packages."
+  (define (same-location? p1 p2)
+    ;; Compare locations of two packages.
+    (equal? (package-location p1) (package-location p2)))
+
+  (delete-duplicates
+   (sort
+    (fold-packages (lambda (package result)
+                     (if (any (lambda (f)
+                                (false-if-exception
+                                 (regexp-exec rx (gettext (f package)))))
+                              (list package-synopsis package-description))
+                         (cons package result)
+                         result))
+                   '())
+    (lambda (p1 p2)
+      (string<? (package-name p1)
+                (package-name p2))))
+   same-location?))
+
 \f
 ;;;
 ;;; Command-line options.
@@ -260,6 +282,8 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
       --verbose          produce verbose output"))
   (newline)
   (display (_ "
+  -s, --search=REGEXP    search in synopsis and description using REGEXP"))
+  (display (_ "
   -I, --list-installed[=REGEXP]
                          list installed packages matching REGEXP"))
   (display (_ "
@@ -305,6 +329,10 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
         (option '("verbose") #f #f
                 (lambda (opt name arg result)
                   (alist-cons 'verbose? #t result)))
+        (option '(#\s "search") #t #f
+                (lambda (opt name arg result)
+                  (cons `(query search ,(or arg ""))
+                        result)))
         (option '(#\I "list-installed") #f #t
                 (lambda (opt name arg result)
                   (cons `(query list-installed ,(or arg ""))
@@ -525,6 +553,7 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
                                  name (or version "?") output path))))
                      installed)
            #t))
+
         (('list-available regexp)
          (let* ((regexp    (and regexp (make-regexp regexp)))
                 (available (fold-packages
@@ -547,6 +576,16 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
                              (string<? (package-name p1)
                                        (package-name p2)))))
            #t))
+
+        (('search regexp)
+         (let ((regexp (and regexp (make-regexp regexp))))
+           (for-each (lambda (p)
+                       (format #t "~a\t~a\t~a~%"
+                               (package-name p)
+                               (package-version p)
+                               (location->string (package-location p))))
+                     (find-packages-by-description regexp))
+           #t))
         (_ #f))))
 
   (setlocale LC_ALL "")
diff --git a/tests/guix-package.sh b/tests/guix-package.sh
index 02ece68..89b2712 100644
--- a/tests/guix-package.sh
+++ b/tests/guix-package.sh
@@ -1,5 +1,6 @@
 # GNU Guix --- Functional package management for GNU
 # Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
+# Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
 #
 # This file is part of GNU Guix.
 #
@@ -68,6 +69,14 @@ then
 
     test "`guix-package -p "$profile" -I 'g.*e' | cut -f1`" = "guile-bootstrap"
 
+    # Search.
+    echo "Testing 'search'..."
+    if test "`guix-package -s "GNU Hello" | cut -f1`" = "hello";
+    then echo "Test1: OK"; else echo "Test1: failed"; fi
+
+    if test "`guix-package -s "n0t4r341p4ck4g3"`" = "";
+    then echo "Test2: OK"; else echo "Test2: failed"; fi
+
     # Remove a package.
     guix-package --bootstrap -p "$profile" -r "guile-bootstrap"
     test -L "$profile-3-link"
-- 
1.7.5.4


[-- Attachment #2: Type: application/pgp-signature, Size: 835 bytes --]