branch master updated: teams: Fix script to produce a single X-Debbugs-Cc header.

[guix-commits]

This is an automated email from the git hooks/post-receive script.

apteryx pushed a commit to branch master
in repository guix.

The following commit(s) were added to refs/heads/master by this push:
     new 125f52c443 teams: Fix script to produce a single X-Debbugs-Cc header.
125f52c443 is described below

commit 125f52c443c0257586421800d3a2e64f58759735
Author: Maxim Cournoyer <maxim.cournoyer@gmail.com>
AuthorDate: Mon May 8 14:21:17 2023 -0400

    teams: Fix script to produce a single X-Debbugs-Cc header.
    
    Fixes <https://issues.guix.gnu.org/63378>.
    
    * etc/teams.scm.in (cc): Adjust format pattern.
    (sort-members, member->string): New procedures.
    (list-members): Refactor in terms of the above procedures.
    (main): Adjust the output of the 'cc-members-header-cmd' and
    'cc-mentors-header-cmd' actions.
    
    Reviewed-by: Arun Isaac <arunisaac@systemreboot.net>
---
 etc/teams.scm.in | 46 ++++++++++++++++++++++++++++------------------
 1 file changed, 28 insertions(+), 18 deletions(-)

diff --git a/etc/teams.scm.in b/etc/teams.scm.in
index d21f1ff67b..c68b995859 100644
--- a/etc/teams.scm.in
+++ b/etc/teams.scm.in
@@ -605,24 +605,32 @@ of file names as string."
 (define (cc . teams)
   "Return arguments for `git send-email' to notify the members of the given
 TEAMS when a patch is received by Debbugs."
-  (format #true
-          "~{--add-header=\"X-Debbugs-Cc: ~a\"~^ ~}"
-          (map person-email
-               (delete-duplicates (append-map team-members teams) equal?))))
+  (let ((members (append-map team-members teams)))
+    (unless (null? members)
+      (format #true "--add-header=\"X-Debbugs-Cc: ~{~a~^, ~}\""
+              (map person-email (sort-members members))))))
+
+(define (sort-members members)
+  "Deduplicate and sort MEMBERS alphabetically by their name."
+  (sort (delete-duplicates members equal?)
+        (lambda (m1 m2)
+          (string<? (person-name m1) (person-name m2)))))
+
+(define (member->string member)
+  "Return the 'email <name>' string representation of MEMBER."
+  (let* ((name (person-name member))
+         (quoted-name/maybe (if (string-contains name ",")
+                                (string-append "\"" name "\"")
+                                name)))
+    (format #false "~a <~a>" quoted-name/maybe (person-email member))))
 
 (define* (list-members team #:optional port (prefix ""))
   "Print the members of the given TEAM."
   (define port* (or port (current-output-port)))
   (for-each
    (lambda (member)
-     (format port*
-             "~a~a <~a>~%"
-             prefix
-             (person-name member)
-             (person-email member)))
-   (sort
-    (team-members team)
-    (lambda (m1 m2) (string<? (person-name m1) (person-name m2))))))
+     (format port* "~a~a~%" prefix (member->string member)))
+   (sort-members (team-members team))))
 
 (define (list-teams)
   "Print all teams, their scope and their members."
@@ -716,13 +724,15 @@ and REV-END, two git revision strings."
      (apply cc (find-team-by-scope
                 (diff-revisions rev-start rev-end))))
     (("cc-members-header-cmd" patch-file)
-     (for-each (lambda (team-name)
-                 (list-members (find-team team-name) (current-output-port)
-                               "X-Debbugs-Cc: "))
-               (patch->teams patch-file)))
+     (let* ((teams (map find-team (patch->teams patch-file)))
+            (members (sort-members (append-map team-members teams))))
+       (unless (null? members)
+         (format #true "X-Debbugs-Cc: ~{~a~^, ~}"
+                 (map member->string members)))))
     (("cc-mentors-header-cmd" patch-file)
-     (list-members (find-team "mentors") (current-output-port)
-                   "X-Debbugs-Cc: "))
+     (format #true "X-Debbugs-Cc: ~{~a~^, ~}"
+             (map member->string
+                  (sort-members (team-members (find-team "mentors"))))))
     (("get-maintainer" patch-file)
      (apply main "list-members" (patch->teams patch-file)))
     (("list-teams" . args)