From: Morgan Smith <Morgan.J.Smith@outlook.com>
To: 75151@debbugs.gnu.org
Cc: Morgan Smith <Morgan.J.Smith@outlook.com>
Subject: [bug#75151] [PATCH] import/utils: beautify-description: Validate argument
Date: Fri, 27 Dec 2024 17:18:38 -0500 [thread overview]
Message-ID: <CH3PR84MB3424E6AE9729DF52B792B1D5C50E2@CH3PR84MB3424.NAMPRD84.PROD.OUTLOOK.COM> (raw)
* 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
reply other threads:[~2024-12-27 22:22 UTC|newest]
Thread overview: [no followups] expand[flat|nested] mbox.gz Atom feed
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=CH3PR84MB3424E6AE9729DF52B792B1D5C50E2@CH3PR84MB3424.NAMPRD84.PROD.OUTLOOK.COM \
--to=morgan.j.smith@outlook.com \
--cc=75151@debbugs.gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
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.