* [bug#75151] [PATCH] import/utils: beautify-description: Validate argument
@ 2024-12-27 22:18 Morgan Smith
0 siblings, 0 replies; only message in thread
From: Morgan Smith @ 2024-12-27 22:18 UTC (permalink / raw)
To: 75151; +Cc: Morgan Smith
* guix/import/utils.scm (beautify-description): Fix broken check for
non-strings. Add a check for empty strings.
* tests/import-utils.scm: Add two tests.
Change-Id: Idf86df02aeb850fcc8808b7c9251082c1f816656
---
Hello!
I was trying to run "guix import hackage orgstat" to no avail. It turns out it
was because 'beautify-description' errors when given the empty string. It
already had a check for arguments that where not a string but that check was
actually broken. So I fixed the existing check and added a new one for an
empty string.
guix/import/utils.scm | 160 +++++++++++++++++++++--------------------
tests/import-utils.scm | 10 +++
2 files changed, 91 insertions(+), 79 deletions(-)
diff --git a/guix/import/utils.scm b/guix/import/utils.scm
index e45c8dfb20..bb268ebe4b 100644
--- a/guix/import/utils.scm
+++ b/guix/import/utils.scm
@@ -328,85 +328,87 @@ (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."
- (unless (string? description)
- (G_ "This package lacks a description. Run \
-\"info '(guix) Synopses and Descriptions'\" for more information."))
-
- (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)
- ;; Wrap camelCase or PascalCase words or text followed
- ;; immediately by "()" in @code{...}.
- (lambda (word)
- (let ((pattern
- (make-regexp
- "([A-Z][a-z]+[A-Z]|[a-z]+[A-Z]|.+\\(\\))")))
- (match (list-matches pattern word)
- (() word)
- ((m . rest)
- ;; Do not include leading or trailing punctuation,
- ;; unless its "()".
- (let* ((last-text (if (string-suffix? "()" (match:substring m 1))
- (string-length (match:substring m 1))
- (or (and=> (string-skip-right word char-set:punctuation) 1+)
- (string-length word))))
- (inner (substring word (match:start m) last-text))
- (pre (string-take word (match:start m)))
- (post (substring word last-text (string-length word))))
- (string-append pre "@code{" inner "}" post))))))))))
- (words
- (string-tokenize (string-trim-both description)
- (char-set-complement
- (char-set #\space #\newline))))
- (new-words
- (match words
- (((and (or "A" "Classes" "Functions" "Methods" "Tools")
- 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)))
- (new-words
- (match new-words
- ((rest ... last)
- (reverse (cons (if (or (string-suffix? "." last)
- (string-suffix? "!" last)
- (string-suffix? "?" last))
- last
- (string-append last "."))
- (reverse rest))))))
- (cleaned
- (string-join (map fix-word new-words))))
- ;; Use double spacing between sentences
- (fill-paragraph (regexp-substitute/global #f "\\. \\b"
- cleaned 'pre
- (lambda (m)
- (let ((pre (match:prefix m))
- (abbrevs '("Dr" "Mr" "Mrs"
- "Ms" "Prof" "vs"
- "e.g")))
- (if (and (> (string-length pre) 0)
- (or (any (cut string-suffix? <> pre) abbrevs)
- (char-upper-case?
- (string-ref pre (1- (string-length pre))))))
- ". "
- ". ")))
- 'post)
- length)))
+ (if (or (not (string? description)) (string=? (string-trim-both description) ""))
+ (G_ "This package lacks a description. Run \
+\"info '(guix) Synopses and Descriptions'\" for more information.")
+
+ (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)
+ ;; Wrap camelCase or PascalCase words or text followed
+ ;; immediately by "()" in @code{...}.
+ (lambda (word)
+ (let ((pattern
+ (make-regexp
+ "([A-Z][a-z]+[A-Z]|[a-z]+[A-Z]|.+\\(\\))")))
+ (match (list-matches pattern word)
+ (() word)
+ ((m . rest)
+ ;; Do not include leading or trailing punctuation,
+ ;; unless its "()".
+ (let* ((last-text
+ (if (string-suffix? "()" (match:substring m 1))
+ (string-length (match:substring m 1))
+ (or (and=> (string-skip-right word char-set:punctuation) 1+)
+ (string-length word))))
+ (inner (substring word (match:start m) last-text))
+ (pre (string-take word (match:start m)))
+ (post (substring word last-text (string-length word))))
+ (string-append pre "@code{" inner "}" post))))))))))
+ (words
+ (string-tokenize (string-trim-both description)
+ (char-set-complement
+ (char-set #\space #\newline))))
+ (new-words
+ (match words
+ (((and (or "A" "Classes" "Functions" "Methods" "Tools")
+ 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)))
+ (new-words
+ (match new-words
+ ((rest ... last)
+ (reverse (cons (if (or (string-suffix? "." last)
+ (string-suffix? "!" last)
+ (string-suffix? "?" last))
+ last
+ (string-append last "."))
+ (reverse rest))))))
+ (cleaned
+ (string-join (map fix-word new-words))))
+ ;; Use double spacing between sentences
+ (fill-paragraph
+ (regexp-substitute/global #f "\\. \\b"
+ cleaned 'pre
+ (lambda (m)
+ (let ((pre (match:prefix m))
+ (abbrevs '("Dr" "Mr" "Mrs"
+ "Ms" "Prof" "vs"
+ "e.g")))
+ (if (and (> (string-length pre) 0)
+ (or (any (cut string-suffix? <> pre) abbrevs)
+ (char-upper-case?
+ (string-ref pre (1- (string-length pre))))))
+ ". "
+ ". ")))
+ 'post)
+ length))))
(define (beautify-synopsis synopsis)
"Improve the package SYNOPSIS."
diff --git a/tests/import-utils.scm b/tests/import-utils.scm
index 607349203c..27bd87940a 100644
--- a/tests/import-utils.scm
+++ b/tests/import-utils.scm
@@ -31,6 +31,16 @@ (define-module (test-import-utils)
(test-begin "import-utils")
+(test-equal "beautify-description: empty string"
+ "This package lacks a description. Run \
+\"info '(guix) Synopses and Descriptions'\" for more information."
+ (beautify-description ""))
+
+(test-equal "beautify-description: not a string"
+ "This package lacks a description. Run \
+\"info '(guix) Synopses and Descriptions'\" for more information."
+ (beautify-description '()))
+
(test-equal "beautify-description: use double spacing"
"\
Trust me Mr. Hendrix, M. Night Shyamalan et al. \
base-commit: 3a8c20408f0078a580d27f74bc69b5a1069a003b
--
2.47.1
^ permalink raw reply related [flat|nested] only message in thread
only message in thread, other threads:[~2024-12-27 22:22 UTC | newest]
Thread overview: (only message) (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2024-12-27 22:18 [bug#75151] [PATCH] import/utils: beautify-description: Validate argument Morgan Smith
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/guix.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.