From 7d04f3ad285225fe44d4aac8680178ed18fcdfb5 Mon Sep 17 00:00:00 2001
From: Ricardo Wurmus <rekado@elephly.net>
Date: Wed, 5 Oct 2022 23:46:27 +0200
Subject: 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.
---
 guix/import/utils.scm | 65 +++++++++++++++++++++++++++++++++++----------------
 1 file changed, 45 insertions(+), 20 deletions(-)

(limited to 'guix/import/utils.scm')

diff --git a/guix/import/utils.scm b/guix/import/utils.scm
index 977e1d5f95..5420037d1d 100644
--- a/guix/import/utils.scm
+++ b/guix/import/utils.scm
@@ -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))
-                   (G_ "This package lacks a description.  Run \
+  (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)
-- 
cgit v1.2.3