rekahsoft
/
guix
1
1
Fork 0
Code Issues Pull Requests Releases Wiki Activity

guix system: Add 'search' command. 

* guix/scripts/system.scm (resolve-subcommand): New procedure.
(process-command): Handle 'search'.
(guix-system): Likewise.
(show-help): Augment.
* guix/scripts/system/search.scm: New file.
* po/guix/POTFILES.in: Add it.
* Makefile.am (MODULES): Add it.
* guix/ui.scm (%text-width): Export.
* doc/guix.texi (Invoking guix system): Document it.
(Service Types and Services): Mention 'guix system search'.
* tests/guix-system.sh: Test it.
This commit is contained in:
Ludovic Courtès 2017-09-13 16:07:30 +02:00
parent 0c0c1b21d9
commit 0649321d91
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
7 changed files with 202 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
Makefile.am
View File

@ -164,6 +164,7 @@ MODULES = \
guix/scripts/authenticate.scm \
guix/scripts/refresh.scm \
guix/scripts/system.scm \
guix/scripts/system/search.scm \
guix/scripts/lint.scm \
guix/scripts/challenge.scm \
guix/scripts/import/cran.scm \

40
doc/guix.texi
View File

@ -17391,6 +17391,42 @@ operating system is instantiated. Currently the following values are
supported:
@table @code
@item search
Display available service type definitions that match the given regular
expressions, sorted by relevance:
@example
$ guix system search console font
name: console-fonts
location: gnu/services/base.scm:729:2
extends: shepherd-root
description: Install the given fonts on the specified ttys (fonts are
+ per virtual console on GNU/Linux). The value of this service is a list
+ of tty/font pairs like:
+
+ '(("tty1" . "LatGrkCyr-8x16"))
relevance: 20
name: mingetty
location: gnu/services/base.scm:1048:2
extends: shepherd-root
description: Provide console login using the `mingetty' program.
relevance: 2
name: login
location: gnu/services/base.scm:775:2
extends: pam
description: Provide a console log-in service as specified by its
+ configuration value, a `login-configuration' object.
relevance: 2
@dots{}
@end example
As for @command{guix package --search}, the result is written in
@code{recutils} format, which makes it easy to filter the output
(@pxref{Top, GNU recutils databases,, recutils, GNU recutils manual}).
@item reconfigure
Build the operating system described in @var{file}, activate it, and
switch to it@footnote{This action (and the related actions
@ -18023,7 +18059,9 @@ list of contributed rules.
@item description
This is a string giving an overview of the service type. The string can
contain Texinfo markup (@pxref{Overview,,, texinfo, GNU Texinfo}).
contain Texinfo markup (@pxref{Overview,,, texinfo, GNU Texinfo}). The
@command{guix system search} command searches these strings and displays
them (@pxref{Invoking guix system}).
@end table
There can be only one instance of an extensible service type such as

13
guix/scripts/system.scm
View File

@ -73,7 +73,6 @@
"Read the operating-system declaration from FILE and return it."
(load* file %user-module))
;;;
;;; Installation.
@ -751,6 +750,8 @@ Some ACTIONS support additional ARGS.\n"))
(newline)
(display (G_ "The valid values for ACTION are:\n"))
(newline)
(display (G_ "\
search search for existing service types\n"))
(display (G_ "\
reconfigure switch to a new operating system configuration\n"))
(display (G_ "\
@ -937,6 +938,12 @@ resulting from command-line parsing."
#:gc-root (assoc-ref opts 'gc-root)))))
#:system system))))
(define (resolve-subcommand name)
(let ((module (resolve-interface
`(guix scripts system ,(string->symbol name))))
(proc (string->symbol (string-append "guix-system-" name))))
(module-ref module proc)))
(define (process-command command args opts)
"Process COMMAND, one of the 'guix system' sub-commands. ARGS is its
argument list and OPTS is the option alist."
@ -949,6 +956,8 @@ argument list and OPTS is the option alist."
((pattern) pattern)
(x (leave (G_ "wrong number of arguments~%"))))))
(list-generations pattern)))
((search)
(apply (resolve-subcommand "search") args))
;; The following commands need to use the store, but they do not need an
;; operating system configuration file.
((switch-generation)
@ -978,7 +987,7 @@ argument list and OPTS is the option alist."
(case action
((build container vm vm-image disk-image reconfigure init
extension-graph shepherd-graph list-generations roll-back
switch-generation)
switch-generation search)
(alist-cons 'action action result))
(else (leave (G_ "~a: unknown action~%") action))))))

144
guix/scripts/system/search.scm Normal file
View File

@ -0,0 +1,144 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017 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 (guix scripts system search)
#:use-module (guix ui)
#:use-module (guix utils)
#:use-module (gnu services)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-11)
#:use-module (srfi srfi-26)
#:use-module (ice-9 regex)
#:use-module (ice-9 match)
#:export (service-type->recutils
find-service-types
guix-system-search))
;;; Commentary:
;;;
;;; Implement the 'guix system search' command, which searches among the
;;; available service types.
;;;
;;; Code:
(define service-type-name*
(compose symbol->string service-type-name))
(define* (service-type->recutils type port
#:optional (width (%text-width))
#:key (extra-fields '()))
"Write to PORT a recutils record of TYPE, arranging to fit within WIDTH
columns."
(define width*
;; The available number of columns once we've taken into account space for
;; the initial "+ " prefix.
(if (> width 2) (- width 2) width))
(define (extensions->recutils extensions)
(let ((list (string-join (map (compose service-type-name*
service-extension-target)
extensions))))
(string->recutils
(fill-paragraph list width*
(string-length "extends: ")))))
;; Note: Don't i18n field names so that people can post-process it.
(format port "name: ~a~%" (service-type-name type))
(format port "location: ~a~%"
(or (and=> (service-type-location type) location->string)
(G_ "unknown")))
(format port "extends: ~a~%"
(extensions->recutils (service-type-extensions type)))
(when (service-type-description type)
(format port "~a~%"
(string->recutils
(string-trim-right
(parameterize ((%text-width width*))
(texi->plain-text
(string-append "description: "
(or (and=> (service-type-description type) P_)
""))))
#\newline))))
(for-each (match-lambda
((field . value)
(let ((field (symbol->string field)))
(format port "~a: ~a~%"
field
(fill-paragraph (object->string value) width*
(string-length field))))))
extra-fields)
(newline port))
(define (service-type-description-string type)
"Return the rendered and localised description of TYPE, a service type."
(and=> (service-type-description type)
(compose texi->plain-text P_)))
(define %service-type-metrics
;; Metrics used to estimate the relevance of a search result.
`((,service-type-name* . 3)
(,service-type-description-string . 2)
(,(lambda (type)
(match (and=> (service-type-location type) location-file)
((? string? file)
(basename file ".scm"))
(#f
"")))
. 1)))
(define (find-service-types regexps)
"Return two values: the list of service types whose name or description
matches at least one of REGEXPS sorted by relevance, and the list of relevance
scores."
(let ((matches (fold-service-types
(lambda (type result)
(match (relevance type regexps
%service-type-metrics)
((? zero?)
result)
(score
(cons (list type score) result))))
'())))
(unzip2 (sort matches
(lambda (m1 m2)
(match m1
((type1 score1)
(match m2
((type2 score2)
(if (= score1 score2)
(string>? (service-type-name* type1)
(service-type-name* type2))
(> score1 score2)))))))))))
(define (guix-system-search . args)
(with-error-handling
(let ((regexps (map (cut make-regexp* <> regexp/icase) args)))
(leave-on-EPIPE
(let-values (((services scores)
(find-service-types regexps)))
(for-each (lambda (service score)
(service-type->recutils service
(current-output-port)
#:extra-fields
`((relevance . ,score))))
services
scores))))))

1
guix/ui.scm
View File

@ -79,6 +79,7 @@
read/eval-package-expression
location->string
fill-paragraph
%text-width
texi->plain-text
package-description-string
package-synopsis-string

1
po/guix/POTFILES.in
View File

@ -19,6 +19,7 @@ guix/scripts/pull.scm
guix/scripts/substitute.scm
guix/scripts/authenticate.scm
guix/scripts/system.scm
guix/scripts/system/search.scm
guix/scripts/lint.scm
guix/scripts/publish.scm
guix/scripts/edit.scm

6
tests/guix-system.sh
View File

@ -1,5 +1,5 @@
# GNU Guix --- Functional package management for GNU
# Copyright © 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
# Copyright © 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
#
# This file is part of GNU Guix.
#
@ -215,3 +215,7 @@ EOF
# In both cases 'my-torrc' should be properly resolved.
guix system build "$tmpdir/config.scm" -n
(cd "$tmpdir"; guix system build "config.scm" -n)
# Searching.
guix system search tor | grep "^name: tor"
guix system search anonym network | grep "^name: tor"