tests/base32.scm \
tests/builders.scm \
tests/derivations.scm \
+ tests/ui.scm \
tests/utils.scm \
tests/build-utils.scm \
tests/packages.scm \
@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}]
(('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))))
#: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)
show-bug-report-information
call-with-error-handling
with-error-handling
- location->string))
+ location->string
+ fill-paragraph
+ string->recutils
+ package->recutils))
;;; Commentary:
;;;
(($ <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
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.
--- /dev/null
+;;; 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.")
+
+\f
+(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")
+
+\f
+(exit (= (test-runner-fail-count (test-runner-current)) 0))
HCoop / jackhill / guix / guix.git / commitdiff