summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMaxim Cournoyer <maxim.cournoyer@gmail.com>2023-05-08 14:21:17 -0400
committerMaxim Cournoyer <maxim.cournoyer@gmail.com>2023-05-11 09:15:48 -0400
commit125f52c443c0257586421800d3a2e64f58759735 (patch)
treee073f86baf4c1c51dfe2f752d0f0c72ea38a3028
parent3186a52e11aa1172c2dbdfe855127c9586f2b3b9 (diff)
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>
-rw-r--r--etc/teams.scm.in46
1 files 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)