guix-package: Report `--search' matches in recutils format.

* guix/ui.scm (fill-paragraph, string->recutils, package->recutils): New
  procedures.
* guix-package.in (guix-package)[process-query]: Use `package->recutils'
  to display package meta-data.
* tests/guix-package.sh: Adjust test.
* tests/ui.scm: New file.
* Makefile.am (TESTS): Add it.
* doc/guix.texi (Invoking guix-package): Adjust `--search'
  documentation, and give an example.

6 files changed, 188 insertions, 10 deletions

diff --git a/Makefile.am b/Makefile.am
index 439b5ff5b4..8588266501 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -234,6 +234,7 @@ TESTS =						\
   tests/base32.scm				\
   tests/builders.scm				\
   tests/derivations.scm				\
+  tests/ui.scm					\
   tests/utils.scm				\
   tests/build-utils.scm				\
   tests/packages.scm				\
diff --git a/doc/guix.texi b/doc/guix.texi
index 410e6fa37c..3fee24db50 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -546,10 +546,21 @@ availability of packages:
 @item --search=@var{regexp}
 @itemx -s @var{regexp}
 List the available packages whose synopsis or description matches
-@var{regexp}.
+@var{regexp}.  Print all the meta-data of matching packages in
+@code{recutils} format (@pxref{Top, GNU recutils databases,, recutils,
+GNU recutils manual}).
 
-For each package, print the following items, separated by tabs: its
-name, version, and the source location of its definition.
+This allows specific fields to be extracted using the @command{recsel}
+command, for instance:
+
+@example
+$ guix-package -s malloc | recsel -p name,version
+name: glibc
+version: 2.17
+
+name: libgc
+version: 7.2alpha6
+@end example
 
 @item --list-installed[=@var{regexp}]
 @itemx -I [@var{regexp}]
diff --git a/guix-package.in b/guix-package.in
index 58164c6e46..e0c3287b3c 100644
--- a/guix-package.in
+++ b/guix-package.in
@@ -597,11 +597,7 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
 
         (('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))))
+           (for-each (cute package->recutils <> (current-output-port))
                      (find-packages-by-description regexp))
            #t))
         (_ #f))))
diff --git a/guix/ui.scm b/guix/ui.scm
index 3ec7be771b..4aa93de3b4 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -21,6 +21,9 @@
   #:use-module (guix store)
   #:use-module (guix config)
   #:use-module (guix packages)
+  #:use-module ((guix licenses) #:select (license? license-name))
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-34)
   #:use-module (ice-9 match)
@@ -32,7 +35,10 @@
             show-bug-report-information
             call-with-error-handling
             with-error-handling
-            location->string))
+            location->string
+            fill-paragraph
+            string->recutils
+            package->recutils))
 
 ;;; Commentary:
 ;;;
@@ -110,4 +116,98 @@ General help using GNU software: <http://www.gnu.org/gethelp/>"))
     (($ <location> file line column)
      (format #f "~a:~a:~a" file line column))))
 
+(define* (fill-paragraph str width #:optional (column 0))
+  "Fill STR such that each line contains at most WIDTH characters, assuming
+that the first character is at COLUMN.
+
+When STR contains a single line break surrounded by other characters, it is
+converted to a space; sequences of more than one line break are preserved."
+  (define (maybe-break chr result)
+    (match result
+      ((column newlines chars)
+       (case chr
+         ((#\newline)
+          `(,column ,(+ 1 newlines) ,chars))
+         (else
+          (let ((chars  (case newlines
+                          ((0) chars)
+                          ((1) (cons #\space chars))
+                          (else
+                           (append (make-list newlines #\newline) chars))))
+                (column (case newlines
+                          ((0) column)
+                          ((1) (+ 1 column))
+                          (else 0))))
+            (let ((chars  (cons chr chars))
+                  (column (+ 1 column)))
+              (if (> column width)
+                  (let*-values (((before after)
+                                 (break (cut eqv? #\space <>) chars))
+                                ((len)
+                                 (length before)))
+                    (if (<= len width)
+                        `(,len
+                          0
+                          ,(if (null? after)
+                               before
+                               (append before (cons #\newline (cdr after)))))
+                        `(,column 0 ,chars)))     ; unbreakable
+                  `(,column 0 ,chars)))))))))
+
+  (match (string-fold maybe-break
+                      `(,column 0 ())
+                      str)
+    ((_ _ chars)
+     (list->string (reverse chars)))))
+
+(define (string->recutils str)
+  "Return a version of STR where newlines have been replaced by newlines
+followed by \"+ \", which makes for a valid multi-line field value in the
+`recutils' syntax."
+  (list->string
+   (string-fold-right (lambda (chr result)
+                        (if (eqv? chr #\newline)
+                            (cons* chr #\+ #\space result)
+                            (cons chr result)))
+                      '()
+                      str)))
+
+(define* (package->recutils p port
+                            #:optional (width (or (and=> (getenv "WIDTH")
+                                                         string->number)
+                                                  80)))
+  "Write to PORT a `recutils' record of package P, arranging to fit within
+WIDTH columns."
+  (define (description->recutils str)
+    (let ((str (_ str)))
+      (string->recutils
+       (fill-paragraph str width
+                       (string-length "description: ")))))
+
+  ;; Note: Don't i18n field names so that people can post-process it.
+  (format port "name: ~a~%" (package-name p))
+  (format port "version: ~a~%" (package-version p))
+  (format port "location: ~a~%"
+          (or (and=> (package-location p) location->string)
+              (_ "unknown")))
+  (format port "home-page: ~a~%" (package-home-page p))
+  (format port "license: ~a~%"
+          (match (package-license p)
+            (((? license? licenses) ...)
+             (string-join (map license-name licenses)
+                          ", "))
+            ((? license? license)
+             (license-name license))
+            (x
+             (_ "unknown"))))
+  (format port "synopsis: ~a~%"
+          (string-map (match-lambda
+                       (#\newline #\space)
+                       (chr       chr))
+                      (or (and=> (package-synopsis p) _)
+                          "")))
+  (format port "description: ~a~%"
+          (and=> (package-description p) description->recutils))
+  (newline port))
+
 ;;; ui.scm ends here
diff --git a/tests/guix-package.sh b/tests/guix-package.sh
index 0b31b55103..42a1f8da96 100644
--- a/tests/guix-package.sh
+++ b/tests/guix-package.sh
@@ -70,7 +70,7 @@ then
     test "`guix-package -p "$profile" -I 'g.*e' | cut -f1`" = "guile-bootstrap"
 
     # Search.
-    test "`guix-package -s "GNU Hello" | cut -f1`" = "hello"
+    test "`guix-package -s "GNU Hello" | grep ^name:`" = "name: hello"
     test "`guix-package -s "n0t4r341p4ck4g3"`" = ""
 
     # Remove a package.
diff --git a/tests/ui.scm b/tests/ui.scm
new file mode 100644
index 0000000000..0b6f3c5815
--- /dev/null
+++ b/tests/ui.scm
@@ -0,0 +1,70 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org>
+;;;
+;;; 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 (test-ui)
+  #:use-module (guix ui)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-64))
+
+;; Test the (guix ui) module.
+
+(define %paragraph
+  "GNU Guile is an implementation of the Scheme programming language, with
+support for many SRFIs, packaged for use in a wide variety of environments.
+In addition to implementing the R5RS Scheme standard and a large subset of
+R6RS, Guile includes a module system, full access to POSIX system calls,
+networking support, multiple threads, dynamic linking, a foreign function call
+interface, and powerful string processing.")
+
+
+(test-begin "ui")
+
+(test-assert "fill-paragraph"
+  (every (lambda (column)
+           (every (lambda (width)
+                    (every (lambda (line)
+                             (<= (string-length line) width))
+                           (string-split (fill-paragraph %paragraph
+                                                         width column)
+                                         #\newline)))
+                  '(15 30 35 40 45 50 60 70 80 90 100)))
+   '(0 5)))
+
+(test-assert "fill-paragraph, consecutive newlines"
+  (every (lambda (width)
+           (any (lambda (line)
+                  (string-prefix? "When STR" line))
+                (string-split
+                 (fill-paragraph (procedure-documentation fill-paragraph)
+                                 width)
+                 #\newline)))
+         '(15 20 25 30 40 50 60)))
+
+(test-equal "fill-paragraph, large unbreakable word"
+  '("Here is a" "very-very-long-word"
+    "and that's" "it.")
+  (string-split
+   (fill-paragraph "Here is a very-very-long-word and that's it."
+                   10)
+   #\newline))
+
+(test-end "ui")
+
+
+(exit (= (test-runner-fail-count (test-runner-current)) 0))