import/utils: beautify-description: Update to pass tests.

* guix/import/utils.scm (beautify-description): Remove single quote wrapping;
escape @; exclude common abbreviations and titles from double-spacing; detect
more sentence fragments.
This commit is contained in:
Ricardo Wurmus 2022-10-05 23:46:27 +02:00
parent 421a87a68a
commit 7d04f3ad28
No known key found for this signature in database
GPG key ID: 197A5888235FACAC

View file

@ -273,29 +273,54 @@ (define* (beautify-description description #:optional (length 80))
"Improve the package DESCRIPTION by turning a beginning sentence fragment into
a proper sentence and by using two spaces between sentences, and wrap lines at
LENGTH characters."
(let ((cleaned (cond
((not (string? description))
(unless (string? description)
(G_ "This package lacks a description. Run \
\"info '(guix) Synopses and Descriptions'\" for more information."))
((string-prefix? "A " description)
(string-append "This package provides a"
(substring description 1)))
((string-prefix? "Provides " description)
(string-append "This package provides"
(substring description
(string-length "Provides"))))
((string-prefix? "Implements " description)
(string-append "This package implements"
(substring description
(string-length "Implements"))))
((string-prefix? "Functions " description)
(string-append "This package provides functions"
(substring description
(string-length "Functions"))))
(else description))))
(let* ((fix-word
(lambda (word)
(fold (lambda (proc acc) (proc acc)) word
(list
;; Remove wrapping in single quotes, common in R packages.
(cut string-trim-both <> #\')
;; Escape single @ to prevent it from being understood as
;; invalid Texinfo syntax.
(cut regexp-substitute/global #f "@" <> 'pre "@@" 'post)))))
(words
(string-tokenize (string-trim-both description)
(char-set-complement
(char-set #\space #\newline))))
(new-words
(match words
(((and (or "A" "Functions" "Methods") first) . rest)
(cons* "This" "package" "provides"
(string-downcase first) rest))
(((and (or "Contains"
"Creates"
"Performs"
"Provides"
"Produces"
"Implements"
"Infers") first) . rest)
(cons* "This" "package"
(string-downcase first) rest))
(_ words)))
(cleaned
(string-join (map fix-word new-words))))
;; Use double spacing between sentences
(fill-paragraph (regexp-substitute/global #f "\\. \\b"
cleaned 'pre ". " 'post)
cleaned 'pre
(lambda (m)
(let ((pre (match:prefix m))
(abbrevs '("Dr" "Mr" "Mrs"
"Ms" "Prof" "vs"
"e.g")))
(if (or (any (cut string-suffix? <> pre) abbrevs)
(char-upper-case?
(string-ref pre (1- (string-length pre)))))
". "
". ")))
'post)
length)))
(define (beautify-synopsis synopsis)