ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2025-01-24 11:39:46 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

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

Browse source 
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>
This commit is contained in:
Maxim Cournoyer 2023-05-08 14:21:17 -04:00
parent 3186a52e11
commit 125f52c443
No known key found for this signature in database
GPG key ID: 1260E46482E63562
1 changed files with 28 additions and 18 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

46
etc/teams.scm.in
View file

@ -605,24 +605,32 @@ (define (find-team-by-scope files)
(define (cc . teams) (define (cc . teams)
"Return arguments for `git send-email' to notify the members of the given "Return arguments for `git send-email' to notify the members of the given
TEAMS when a patch is received by Debbugs." TEAMS when a patch is received by Debbugs."
(format #true (let ((members (append-map team-members teams)))
"~{--add-header=\"X-Debbugs-Cc: ~a\"~^ ~}" (unless (null? members)
(map person-email (format #true "--add-header=\"X-Debbugs-Cc: ~{~a~^, ~}\""
(delete-duplicates (append-map team-members teams) equal?)))) (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 "")) (define* (list-members team #:optional port (prefix ""))
"Print the members of the given TEAM." "Print the members of the given TEAM."
(define port* (or port (current-output-port))) (define port* (or port (current-output-port)))
(for-each (for-each
(lambda (member) (lambda (member)
(format port* (format port* "~a~a~%" prefix (member->string member)))
"~a~a <~a>~%" (sort-members (team-members team))))
prefix
(person-name member)
(person-email member)))
(sort
(team-members team)
(lambda (m1 m2) (string<? (person-name m1) (person-name m2))))))
(define (list-teams) (define (list-teams)
"Print all teams, their scope and their members." "Print all teams, their scope and their members."
@ -716,13 +724,15 @@ (define (main . args)
(apply cc (find-team-by-scope (apply cc (find-team-by-scope
(diff-revisions rev-start rev-end)))) (diff-revisions rev-start rev-end))))
(("cc-members-header-cmd" patch-file) (("cc-members-header-cmd" patch-file)
(for-each (lambda (team-name) (let* ((teams (map find-team (patch->teams patch-file)))
(list-members (find-team team-name) (current-output-port) (members (sort-members (append-map team-members teams))))
"X-Debbugs-Cc: ")) (unless (null? members)
(patch->teams patch-file))) (format #true "X-Debbugs-Cc: ~{~a~^, ~}"
(map member->string members)))))
(("cc-mentors-header-cmd" patch-file) (("cc-mentors-header-cmd" patch-file)
(list-members (find-team "mentors") (current-output-port) (format #true "X-Debbugs-Cc: ~{~a~^, ~}"
"X-Debbugs-Cc: ")) (map member->string
(sort-members (team-members (find-team "mentors"))))))
(("get-maintainer" patch-file) (("get-maintainer" patch-file)
(apply main "list-members" (patch->teams patch-file))) (apply main "list-members" (patch->teams patch-file)))
(("list-teams" . args) (("list-teams" . args)