diff options
| -rw-r--r-- | Makefile.am | 1 | ||||
| -rw-r--r-- | doc/guix.texi | 40 | ||||
| -rw-r--r-- | guix/scripts/system.scm | 13 | ||||
| -rw-r--r-- | guix/scripts/system/search.scm | 144 | ||||
| -rw-r--r-- | guix/ui.scm | 1 | ||||
| -rw-r--r-- | po/guix/POTFILES.in | 1 | ||||
| -rw-r--r-- | tests/guix-system.sh | 6 |
7 files changed, 202 insertions, 4 deletions
diff --git a/Makefile.am b/Makefile.am index aca18526f7..a2fb313916 100644 --- a/Makefile.am +++ b/Makefile.am @@ -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 \ diff --git a/doc/guix.texi b/doc/guix.texi index b2eed51bd0..ebeef50709 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -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 diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index ea35fcdbc9..567d8bb643 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -73,7 +73,6 @@ "Read the operating-system declaration from FILE and return it." (load* file %user-module)) - ;;; ;;; Installation. @@ -752,6 +751,8 @@ Some ACTIONS support additional ARGS.\n")) (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_ "\ roll-back switch to the previous operating system configuration\n")) @@ -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)))))) diff --git a/guix/scripts/system/search.scm b/guix/scripts/system/search.scm new file mode 100644 index 0000000000..b4f790c9bf --- /dev/null +++ b/guix/scripts/system/search.scm @@ -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)))))) diff --git a/guix/ui.scm b/guix/ui.scm index a51877c04d..6dfc8c7a5b 100644 --- a/guix/ui.scm +++ b/guix/ui.scm @@ -79,6 +79,7 @@ read/eval-package-expression location->string fill-paragraph + %text-width texi->plain-text package-description-string package-synopsis-string diff --git a/po/guix/POTFILES.in b/po/guix/POTFILES.in index b8e0aca877..e3f767cc67 100644 --- a/po/guix/POTFILES.in +++ b/po/guix/POTFILES.in @@ -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 diff --git a/tests/guix-system.sh b/tests/guix-system.sh index de6db0928c..d575795ea0 100644 --- a/tests/guix-system.sh +++ b/tests/guix-system.sh @@ -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" |