Add guix search command

[Andy Wingo]

Here's an implementation of a guix search command.  By default it gives
similar output as compared to "apt-cache search", just printing the
package name and synopsis; you can make it print recutils-style info
instead.  You can also limit search to installed packages, though that
predicate is really "available packages for which there is also a
manifest entry in a profile that has the same name".

WDYT?

Andy

>From 9c99457bbcdf209a80bd280563e660010be160ed Mon Sep 17 00:00:00 2001
From: Andy Wingo <address@hidden>
Date: Wed, 5 Aug 2015 13:03:43 +0200
Subject: [PATCH] Add guix search command

* Makefile.am: Add search.scm.
* doc.am: Add search command.
* doc/guix.texi (Invoking guix search): New section.
* NEWS: Update.
* guix/scripts/search.scm: New file.
---
 Makefile.am             |   1 +
 NEWS                    |   2 +-
 doc.am                  |   1 +
 doc/guix.texi           |  48 ++++++++++
 guix/scripts/search.scm | 239 ++++++++++++++++++++++++++++++++++++++++++++++++
 5 files changed, 290 insertions(+), 1 deletion(-)
 create mode 100644 guix/scripts/search.scm

diff --git a/Makefile.am b/Makefile.am
index 47fa243..5a2a82e 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -109,6 +109,7 @@ MODULES =                                   \
   guix/scripts/gc.scm                          \
   guix/scripts/hash.scm                                \
   guix/scripts/pull.scm                                \
+  guix/scripts/search.scm                      \
   guix/scripts/substitute.scm                  \
   guix/scripts/authenticate.scm                        \
   guix/scripts/refresh.scm                     \
diff --git a/NEWS b/NEWS
index c72c86a..7421738 100644
--- a/NEWS
+++ b/NEWS
@@ -14,7 +14,7 @@ Please send Guix bug reports to address@hidden
 
 ** Package management
 
-*** New ‘guix edit’, ‘guix size’, and ‘guix install’ commands
+*** New ‘guix edit’, ‘guix size’, ‘guix install’, and ‘guix search’ commands
 *** New ‘--manifest’ option for ‘guix package’, for declarative profiles
 *** Similarly, new ‘M-x guix-apply-manifest’ for the Emacs UI
 *** Emacs support now includes completion for ‘guix’ commands in shell-mode
diff --git a/doc.am b/doc.am
index 7f21ec3..7db1117 100644
--- a/doc.am
+++ b/doc.am
@@ -113,6 +113,7 @@ SUBCOMMANDS :=                                      \
   publish                                      \
   pull                                         \
   refresh                                      \
+  search                                       \
   size                                         \
   system
 
diff --git a/doc/guix.texi b/doc/guix.texi
index 2b09a30..425975e 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -132,6 +132,7 @@ Utilities
 * Invoking guix import::        Importing package definitions.
 * Invoking guix refresh::       Updating package definitions.
 * Invoking guix lint::          Finding errors in package definitions.
+* Invoking guix search::        Searching for packages.
 * Invoking guix size::          Profiling disk usage.
 * Invoking guix environment::   Setting up development environments.
 * Invoking guix publish::       Sharing substitutes.
@@ -1388,6 +1389,9 @@ List the available packages whose name, synopsis, or 
description matches
 @code{recutils} format (@pxref{Top, GNU recutils databases,, recutils,
 GNU recutils manual}).
 
+There is also a @command{guix search} command implementing similar
+functionality.  @xref{Invoking guix search}, for more.
+
 This allows specific fields to be extracted using the @command{recsel}
 command, for instance:
 
@@ -3472,6 +3476,7 @@ programming interface of Guix in a convenient way.
 * Invoking guix import::        Importing package definitions.
 * Invoking guix refresh::       Updating package definitions.
 * Invoking guix lint::          Finding errors in package definitions.
+* Invoking guix search::        Searching for packages.
 * Invoking guix size::          Profiling disk usage.
 * Invoking guix environment::   Setting up development environments.
 * Invoking guix publish::       Sharing substitutes.
@@ -4214,6 +4219,49 @@ and exit.
 
 @end table
 
address@hidden Invoking guix search
address@hidden Invoking @command{guix search}
+
+The @command{guix search} command is a simple interface to query what
+packages are installed and available, optionally filtering by name, with
+some control over how the results are printed.  The general syntax is:
+
address@hidden
+guix search @var{options} @address@hidden
address@hidden example
+
+Invoking @command{guix search} will find all packages matching the
+specified @var{pattern} regular expressions, or all packages if no
address@hidden argument is given.  By default, the results will be
+printed on one line apiece, with each line indicating the package name
+and its synopsis.
+
+The available options are:
+
address@hidden @code
+
address@hidden --installed
address@hidden -I
+Only search for available packages that are also installed.
+
address@hidden --available
address@hidden -A
+Search all available packages.
+
address@hidden address@hidden
address@hidden -p @var{profile}
+Use @var{profile} instead of the user's default profile when searching
+for installed packages.
+
address@hidden --short
+Show output in @address@hidden: @var{synopsis}} format.  This is the
+default.
+
address@hidden --recutils
+Show output in @code{recutils} format (@pxref{Top, GNU recutils
+databases,, recutils, GNU recutils manual}).
address@hidden table
+
 @node Invoking guix size
 @section Invoking @command{guix size}
 
diff --git a/guix/scripts/search.scm b/guix/scripts/search.scm
new file mode 100644
index 0000000..3fe2576
--- /dev/null
+++ b/guix/scripts/search.scm
@@ -0,0 +1,239 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès <address@hidden>
+;;; Copyright © 2013 Nikita Karetnikov <address@hidden>
+;;; Copyright © 2013, 2015 Mark H Weaver <address@hidden>
+;;; Copyright © 2014 Alex Kost <address@hidden>
+;;; Copyright © 2015 Andy Wingo <address@hidden>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guix scripts search)
+  #:use-module (guix ui)
+  #:use-module (guix store)
+  #:use-module (guix derivations)
+  #:use-module (guix packages)
+  #:use-module (guix profiles)
+  #:use-module (guix search-paths)
+  #:use-module (guix monads)
+  #:use-module (guix utils)
+  #:use-module (guix config)
+  #:use-module ((guix build utils)
+                #:select (directory-exists? mkdir-p search-path-as-list))
+  #:use-module (ice-9 format)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 regex)
+  #:use-module (ice-9 vlist)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-11)
+  #:use-module (srfi srfi-19)
+  #:use-module (srfi srfi-26)
+  #:use-module (srfi srfi-34)
+  #:use-module (srfi srfi-35)
+  #:use-module (srfi srfi-37)
+  #:use-module (gnu packages)
+  #:use-module (gnu packages base)
+  #:use-module (gnu packages guile)
+  #:use-module ((gnu packages bootstrap) #:select (%bootstrap-guile))
+  #:export (guix-search))
+
+(define %store
+  (make-parameter #f))
+
+
+;;;
+;;; Profiles.
+;;;
+
+(define %user-profile-directory
+  (and=> (getenv "HOME")
+         (cut string-append <> "/.guix-profile")))
+
+(define %profile-directory
+  (string-append %state-directory "/profiles/"
+                 (or (and=> (or (getenv "USER")
+                                (getenv "LOGNAME"))
+                            (cut string-append "per-user/" <>))
+                     "default")))
+
+(define %current-profile
+  ;; Call it `guix-profile', not `profile', to allow Guix profiles to
+  ;; coexist with Nix profiles.
+  (string-append %profile-directory "/guix-profile"))
+
+
+;;;
+;;; Package specifications.
+;;;
+
+(define (package<? p1 p2)
+  (define version<? (negate version>=?))
+
+  (lambda (p1 p2)
+    (case (string-compare (package-name p1) (package-name p2)
+                          (const '<) (const '=) (const '>))
+      ((=)  (version<? (package-version p1) (package-version p2)))
+      ((<)  #t)
+      (else #f))))
+
+(define* (filter-packages matches? #:key profile)
+  (define manifest
+    (if profile (profile-manifest profile) #f))
+
+  (define (visit package tail)
+    (if (and (matches? package)
+             (or (not manifest)
+                 (let ((pattern (manifest-pattern
+                                  (name (package-name package)))))
+                   (manifest-installed? manifest pattern))))
+        (cons package tail)
+        tail))
+   
+  (sort (fold-packages visit '()) package<?))
+
+(define* (find-packages patterns #:key profile
+                        (search-in-synopsis? #t)
+                        (search-in-description? #t))
+  (define filter-installed?)
+
+  (define matches?
+    (match patterns
+      (() (lambda (_) #t))
+      (_
+       (let ((regexps (map (cut make-regexp <> regexp/icase)
+                           patterns)))
+         (lambda (str)
+           (or-map (cut regexp-exec <> str) regexps))))))
+
+  (define (package-matches? package)
+    (or (matches? (package-name package))
+        (and search-in-description?
+             (and=> (package-synopsis package)
+                    (compose matches? P_)))
+        (and search-in-synopsis?
+             (and=> (package-description package)
+                    (compose matches? P_)))))
+
+  (filter-packages package-matches? #:profile profile))
+
+
+;;;
+;;; Pretty-printing.
+;;;
+
+(define (show-packages packages pretty)
+  (leave-on-EPIPE
+   (match pretty
+     ('short
+      (for-each (lambda (package)
+                  (format #t "~a ~24t~a"
+                          (package-name package)
+                          (P_ (package-synopsis package)))
+                  (newline))
+                packages))
+     ('recutils
+      (for-each (cute package->recutils <> (current-output-port))
+                packages)))))
+
+
+;;;
+;;; Command-line options.
+;;;
+
+(define %default-options
+  ;; Alist of default option values.
+  `((profile . ,%current-profile)
+    (max-silent-time . 3600)
+    (verbosity . 0)
+    (pretty . short)
+    (substitutes? . #t)))
+
+(define (show-help)
+  (display (_ "Usage: guix search [OPTION]... [REGEXP]
+Search for packages matching REGEXP.\n"))
+  (display (_ "
+  -p, --profile=PROFILE  use PROFILE instead of the user's default profile"))
+  (newline)
+  (display (_ "
+  -I, --installed
+                         only search installed packages"))
+  (display (_ "
+  -A, --available
+                         search all available packages"))
+  (newline)
+  (display (_ "
+  --short
+                         show output in NAME: SYNOPSIS format (default)"))
+  (display (_ "
+  --recutils
+                         show output in recutils format"))
+  (newline)
+  (display (_ "
+  -h, --help             display this help and exit"))
+  (display (_ "
+  -V, --version          display version information and exit"))
+  (newline)
+  (show-bug-report-information))
+
+(define %options
+  ;; Specification of the command-line options.
+  (list (option '(#\h "help") #f #f
+                (lambda args
+                  (show-help)
+                  (exit 0)))
+        (option '(#\V "version") #f #f
+                (lambda args
+                  (show-version-and-exit "guix package")))
+        (option '(#\p "profile") #t #f
+                (lambda (opt name arg result)
+                  (alist-cons 'profile arg
+                              (alist-delete 'profile result))))
+        (option '(#\I "installed") #f #f
+                (lambda (opt name arg result)
+                  (alist-cons 'only-installed? #t result)))
+        (option '(#\A "available") #f #f
+                (lambda (opt name arg result)
+                  (alist-cons 'only-installed? #f result)))
+        (option '("short") #f #f
+                (lambda (opt name arg result)
+                  (alist-cons 'pretty 'short result)))
+        (option '("recutils") #f #f
+                (lambda (opt name arg result)
+                  (alist-cons 'pretty 'recutils result)))))
+
+
+;;;
+;;; Entry point.
+;;;
+
+(define (guix-search . args)
+  (define (handle-argument arg result)
+    ;; Process non-option argument ARG by calling back ARG-HANDLER.
+    (alist-cons 'search arg result))
+
+  (let ((opts (parse-command-line args %options (list %default-options)
+                                  #:argument-handler handle-argument)))
+    (with-error-handling
+      (let* ((patterns (fold (lambda (opt patterns)
+                               (match opt
+                                 (('search . pattern) (cons pattern patterns))
+                                 (_ patterns)))
+                             '() opts))
+             (only-installed? (assoc-ref opts 'only-installed?))
+             (profile (and only-installed? (assoc-ref opts 'profile)))
+             (pretty (assoc-ref opts 'pretty))
+             (packages (find-packages patterns #:profile profile)))
+        (leave-on-EPIPE
+         (show-packages packages pretty))))))
-- 
2.4.3