da6c6763fa
Previously, service descriptions appeared in both guix.pot and
packages.pot, but only translations of packages.pot were used.
Now, translations are only done with guix.pot.
This is better, because translators are more likely to translate
guix.pot, and is also easier, because files in gnu/{home/,}services
need to be in po/guix/POTFILES.in anyway and po/guix/Makevars
already acts on the 'description' keyword because of lint checkers.
* guix/scripts/home.scm (service-type-description-string):
Use translations from guix.pot.
* guix/scripts/system/search.scm (service-type-description-string)
(service-type->recutils): Likewise.
* po/packages/POTFILES.in: Move files in gnu/services to ...
* po/guix/POTFILES.in: ... here.
194 lines
7.4 KiB
Scheme
194 lines
7.4 KiB
Scheme
;;; GNU Guix --- Functional package management for GNU
|
||
;;; Copyright © 2017-2019, 2022 Ludovic Courtès <ludo@gnu.org>
|
||
;;; Copyright © 2018 Clément Lassieur <clement@lassieur.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)
|
||
#:autoload (guix colors) (color-output? highlight supports-hyperlinks?)
|
||
#:autoload (guix diagnostics) (location->hyperlink)
|
||
#:use-module (gnu services)
|
||
#:use-module (gnu services shepherd)
|
||
#:use-module (srfi srfi-1)
|
||
#:use-module (srfi srfi-11)
|
||
#:use-module (srfi srfi-26)
|
||
#:use-module (srfi srfi-34)
|
||
#:use-module (ice-9 format)
|
||
#: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-default-shepherd-services type)
|
||
"Return the list of Shepherd services created by default instances of TYPE,
|
||
provided TYPE has a default value."
|
||
(match (guard (c ((service-error? c) #f))
|
||
(service type))
|
||
(#f '())
|
||
((? service? service)
|
||
(let* ((extension (find (lambda (extension)
|
||
(eq? (service-extension-target extension)
|
||
shepherd-root-service-type))
|
||
(service-type-extensions type)))
|
||
(compute (and extension (service-extension-compute extension))))
|
||
(if compute
|
||
(compute (service-value service))
|
||
'())))))
|
||
|
||
(define (service-type-shepherd-names type)
|
||
"Return the default names of Shepherd services created for TYPE."
|
||
(append-map shepherd-service-provision
|
||
(service-type-default-shepherd-services type)))
|
||
|
||
(define* (service-type->recutils type port
|
||
#:optional (width (%text-width))
|
||
#:key
|
||
(extra-fields '())
|
||
(hyperlinks? (supports-hyperlinks? port))
|
||
(highlighting identity))
|
||
"Write to PORT a recutils record of TYPE, arranging to fit within WIDTH
|
||
columns. When HYPERLINKS? is true, emit hyperlink escape sequences when
|
||
appropriate. Pass the description through HIGHLIGHTING, a one-argument
|
||
procedure that may return a colorized version of its argument."
|
||
(define port*
|
||
(or (pager-wrapped-port port) port))
|
||
|
||
(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: ")))))
|
||
|
||
(define highlighting*
|
||
(if (color-output? port*)
|
||
highlighting
|
||
identity))
|
||
|
||
;; Note: Don't i18n field names so that people can post-process it.
|
||
(format port "name: ~a~%"
|
||
(highlight (symbol->string (service-type-name type))
|
||
port*))
|
||
(format port "location: ~a~%"
|
||
(or (and=> (service-type-location type)
|
||
(if hyperlinks? location->hyperlink location->string))
|
||
(G_ "unknown")))
|
||
|
||
(format port "extends: ~a~%"
|
||
(extensions->recutils (service-type-extensions type)))
|
||
|
||
;; If possible, display the list of *default* Shepherd service names. Note
|
||
;; that we may not always be able to do this (e.g., if the service type
|
||
;; lacks a default value); furthermore, it could be that the service
|
||
;; generates Shepherd services with different names if we give it different
|
||
;; parameters (this is the case, for instance, for
|
||
;; 'console-font-service-type'.)
|
||
(match (service-type-shepherd-names type)
|
||
(() #f)
|
||
(names (format port "shepherdnames:~{ ~a~}~%" names)))
|
||
|
||
(when (service-type-description type)
|
||
(format port "~a~%"
|
||
(highlighting*
|
||
(string->recutils
|
||
(string-trim-right
|
||
(parameterize ((%text-width width*))
|
||
(texi->plain-text
|
||
(string-append "description: "
|
||
(or (and=> (service-type-description type) G_)
|
||
""))))
|
||
#\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 G_)))
|
||
|
||
(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 a list of service type/score pairs: service types whose name or
|
||
description matches REGEXPS sorted by relevance, and their score."
|
||
(let ((matches (fold-service-types
|
||
(lambda (type result)
|
||
(match (relevance type regexps
|
||
%service-type-metrics)
|
||
((? zero?)
|
||
result)
|
||
(score
|
||
(cons (cons type score) result))))
|
||
'())))
|
||
(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))
|
||
(matches (find-service-types regexps)))
|
||
(leave-on-EPIPE
|
||
(display-search-results matches (current-output-port)
|
||
#:print service-type->recutils
|
||
#:regexps regexps
|
||
#:command "guix system search")))))
|