Commit | Line | Data |
---|---|---|
4eaf9047 RW |
1 | #!@GUILE@ \ |
2 | --no-auto-compile -s | |
3 | !# | |
4 | ||
5 | ;;; GNU Guix --- Functional package management for GNU | |
6 | ;;; Copyright © 2022 Ricardo Wurmus <rekado@elephly.net> | |
7 | ;;; | |
8 | ;;; This file is part of GNU Guix. | |
9 | ;;; | |
10 | ;;; GNU Guix is free software; you can redistribute it and/or modify it | |
11 | ;;; under the terms of the GNU General Public License as published by | |
12 | ;;; the Free Software Foundation; either version 3 of the License, or (at | |
13 | ;;; your option) any later version. | |
14 | ;;; | |
15 | ;;; GNU Guix is distributed in the hope that it will be useful, but | |
16 | ;;; WITHOUT ANY WARRANTY; without even the implied warranty of | |
17 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
18 | ;;; GNU General Public License for more details. | |
19 | ;;; | |
20 | ;;; You should have received a copy of the GNU General Public License | |
21 | ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. | |
22 | ||
23 | ;;; Commentary: | |
24 | ||
25 | ;; This code defines development teams and team members. | |
26 | ||
27 | ;;; Code: | |
28 | ||
29 | (use-modules (srfi srfi-1) | |
30 | (srfi srfi-9) | |
31 | (ice-9 format) | |
32 | (ice-9 match) | |
33 | (guix ui)) | |
34 | ||
35 | (define-record-type <team> | |
36 | (make-team id name description members) | |
37 | team? | |
38 | (id team-id) | |
39 | (name team-name) | |
40 | (description team-description) | |
41 | (members team-members set-team-members!)) | |
42 | ||
43 | (define-record-type <person> | |
44 | (make-person name email) | |
45 | person? | |
46 | (name person-name) | |
47 | (email person-email)) | |
48 | ||
49 | (define* (person name #:optional email) | |
50 | (make-person name email)) | |
51 | ||
52 | (define* (team id #:key name description (members '())) | |
53 | (make-team id | |
54 | (or name (symbol->string id)) | |
55 | description | |
56 | members)) | |
57 | ||
58 | (define %teams | |
59 | (make-hash-table)) | |
60 | ||
61 | (define-syntax define-team | |
62 | (lambda (x) | |
63 | (syntax-case x () | |
64 | ((_ id value) | |
65 | #`(begin | |
66 | (define-public id value) | |
67 | (hash-set! %teams 'id id)))))) | |
68 | ||
69 | (define-syntax-rule (define-member person teams ...) | |
70 | (let ((p person)) | |
71 | (for-each (lambda (team-id) | |
72 | (let ((team | |
73 | (hash-ref %teams team-id | |
74 | (lambda () | |
75 | (error (format #false | |
76 | "Unknown team ~a for ~a~%" | |
77 | team-id p)))))) | |
78 | (set-team-members! | |
79 | team (cons p (team-members team))))) | |
80 | (quote (teams ...))))) | |
81 | ||
82 | \f | |
83 | (define-team python | |
84 | (team 'python | |
85 | #:name "Python team" | |
86 | #:description | |
87 | "Python, Python packages, the \"pypi\" importer, and the python-build-system.")) | |
88 | ||
89 | (define-team haskell | |
90 | (team 'haskell | |
91 | #:name "Haskell team" | |
92 | #:description | |
93 | "GHC, Hugs, Haskell packages, the \"hackage\" and \"stackage\" importers, and | |
94 | the haskell-build-system.")) | |
95 | ||
96 | (define-team r | |
97 | (team 'r | |
98 | #:name "R team" | |
99 | #:description | |
100 | "The R language, CRAN and Bioconductor repositories, the \"cran\" importer, | |
101 | and the r-build-system.")) | |
102 | ||
103 | (define-team julia | |
104 | (team 'julia | |
105 | #:name "Julia team" | |
106 | #:description | |
107 | "The Julia language, Julia packages, and the julia-build-system.")) | |
108 | ||
109 | (define-team ocaml | |
110 | (team 'ocaml | |
111 | #:name "OCaml and Dune team" | |
112 | #:description | |
113 | "The OCaml language, the Dune build system, OCaml packages, the \"opam\" | |
114 | importer, and the ocaml-build-system.")) | |
115 | ||
116 | (define-team java | |
117 | (team 'java | |
118 | #:name "Java and Maven team" | |
119 | #:description | |
120 | "The JDK and JRE, the Maven build system, Java packages, the ant-build-system, | |
121 | and the maven-build-system.")) | |
122 | ||
4a2f4877 AE |
123 | (define-team science |
124 | (team 'science | |
125 | #:name "Science team")) | |
4eaf9047 RW |
126 | |
127 | (define-team emacs | |
128 | (team 'emacs | |
129 | #:name "Emacs team")) | |
130 | ||
131 | (define-team lisp | |
132 | (team 'lisp | |
133 | #:name "Lisp team")) | |
134 | ||
135 | (define-team ruby | |
136 | (team 'ruby | |
137 | #:name "Ruby team")) | |
138 | ||
139 | (define-team go | |
140 | (team 'go | |
141 | #:name "Go team")) | |
142 | ||
143 | (define-team embedded-bootstrap | |
144 | (team 'embedded-bootstrap | |
145 | #:name "Embedded / Bootstrap")) | |
146 | ||
147 | (define-team rust | |
148 | (team 'rust | |
149 | #:name "Rust")) | |
150 | ||
151 | (define-team kernel | |
152 | (team 'kernel | |
153 | #:name "Linux-libre kernel team")) | |
154 | ||
155 | (define-team core | |
156 | (team 'core | |
157 | #:name "Core / Tools / Internals")) | |
158 | ||
159 | (define-team games | |
160 | (team 'games | |
161 | #:name "Games and Videos")) | |
162 | ||
163 | (define-team translations | |
164 | (team 'translations | |
165 | #:name "Translations")) | |
166 | ||
167 | (define-team installer | |
168 | (team 'installer | |
169 | #:name "Installer script and system installer")) | |
170 | ||
171 | (define-team home | |
172 | (team 'home | |
173 | #:name "Team for \"guix home\"")) | |
174 | ||
175 | (define-team mentors | |
176 | (team 'mentors | |
177 | #:name "Mentors" | |
178 | #:description | |
179 | "A group of mentors who chaperone contributions by newcomers.")) | |
180 | ||
a3f8eac5 JB |
181 | (define-team mozilla |
182 | (team 'mozilla | |
183 | #:name "Mozilla" | |
791620b6 | 184 | #:description |
a3f8eac5 JB |
185 | "Taking care about Icecat and Icedove, built from Mozilla Firefox |
186 | and Thunderbird.")) | |
187 | ||
4eaf9047 | 188 | \f |
d301374d TJB |
189 | (define-member (person "Thiago Jung Bauermann" |
190 | "bauermann@kolabnow.com") | |
191 | embedded-bootstrap translations) | |
192 | ||
791620b6 EB |
193 | (define-member (person "Eric Bavier" |
194 | "bavier@posteo.net") | |
195 | science) | |
196 | ||
c3e45324 LDB |
197 | (define-member (person "Lars-Dominik Braun" |
198 | "lars@6xq.net") | |
199 | python haskell) | |
200 | ||
45ca6967 JB |
201 | (define-member (person "Jonathan Brielmaier" |
202 | "jonathan.brielmaier@web.de") | |
203 | mozilla) | |
204 | ||
4eaf9047 RW |
205 | (define-member (person "Ludovic Courtès" |
206 | "ludo@gnu.org") | |
207 | core home embedded-bootstrap mentors) | |
208 | ||
4a2f4877 AE |
209 | (define-member (person "Andreas Enge" |
210 | "andreas@enge.fr") | |
211 | science) | |
4eaf9047 | 212 | |
ff751a68 BH |
213 | (define-member (person "Björn Höfling" |
214 | "bjoern.hoefling@bjoernhoefling.de") | |
215 | java) | |
216 | ||
1f33ff11 LF |
217 | (define-member (person "Leo Famulari" |
218 | "leo@famulari.name") | |
219 | kernel) | |
220 | ||
47ed000d EF |
221 | (define-member (person "Efraim Flashner" |
222 | "efraim@flashner.co.il") | |
223 | embedded-bootstrap julia rust science) | |
224 | ||
3e8a1e8f G |
225 | (define-member (person "jgart" |
226 | "jgart@dismail.de") | |
227 | python lisp mentors) | |
228 | ||
3ce152bf JL |
229 | (define-member (person "Julien Lepiller" |
230 | "julien@lepiller.eu") | |
231 | java ocaml translations) | |
232 | ||
0e6e0374 MO |
233 | (define-member (person "Mathieu Othacehe" |
234 | "othacehe@gnu.org") | |
26629d3c | 235 | core installer mentors) |
0e6e0374 | 236 | |
b150c70b FP |
237 | (define-member (person "Florian Pelz" |
238 | "pelzflorian@pelzflorian.de") | |
239 | translations) | |
240 | ||
9cdfecc8 LMP |
241 | (define-member (person "Liliana Marie Prikler" |
242 | "liliana.prikler@gmail.com") | |
243 | emacs games) | |
244 | ||
672c863f LMP |
245 | (define-member (person "Ricardo Wurmus" |
246 | "rekado@elephly.net") | |
247 | r core mentors) | |
248 | ||
6e2f5fe2 CB |
249 | (define-member (person "Christopher Baines" |
250 | "mail@cbaines.net") | |
251 | core mentors ruby) | |
252 | ||
4eaf9047 RW |
253 | \f |
254 | (define (find-team name) | |
255 | (or (hash-ref %teams (string->symbol name)) | |
256 | (error (format #false | |
257 | "no such team: ~a~%" name)))) | |
258 | ||
259 | (define (cc . teams) | |
260 | "Return arguments for `git send-email' to notify the members of the given | |
261 | TEAMS when a patch is received by Debbugs." | |
262 | (format #true | |
263 | "~{--add-header=\"X-Debbugs-Cc: ~a\"~^ ~}" | |
264 | (map person-email | |
265 | (delete-duplicates (append-map team-members teams) equal?)))) | |
266 | ||
267 | (define* (list-members team #:optional port (prefix "")) | |
268 | "Print the members of the given TEAM." | |
269 | (define port* (or port (current-output-port))) | |
270 | (for-each | |
271 | (lambda (member) | |
272 | (format port* | |
273 | "~a~a <~a>~%" | |
274 | prefix | |
275 | (person-name member) | |
276 | (person-email member))) | |
277 | (team-members team))) | |
278 | ||
279 | (define (list-teams) | |
280 | "Print all teams and their members." | |
281 | (define port* (current-output-port)) | |
282 | (define width* (%text-width)) | |
283 | (hash-for-each | |
284 | (lambda (key team) | |
285 | (format port* | |
286 | "\ | |
287 | id: ~a | |
288 | name: ~a | |
289 | description: ~a | |
290 | members: | |
291 | " | |
292 | (team-id team) | |
293 | (team-name team) | |
294 | (or (and=> (team-description team) | |
295 | (lambda (text) | |
296 | (string->recutils | |
297 | (fill-paragraph text width* | |
298 | (string-length "description: "))))) | |
299 | "<none>")) | |
300 | (list-members team port* "+ ") | |
301 | (newline)) | |
302 | %teams)) | |
303 | ||
304 | (define (main . args) | |
305 | (match args | |
306 | (("cc" . team-names) | |
307 | (apply cc (map find-team team-names))) | |
308 | (("list-teams" . args) | |
309 | (list-teams)) | |
310 | (("list-members" . team-names) | |
311 | (for-each | |
312 | (lambda (team-name) | |
313 | (list-members (find-team team-name))) | |
314 | team-names)) | |
315 | (anything | |
316 | (format (current-error-port) | |
317 | "Usage: etc/teams.scm <command> [<args>]~%")))) | |
318 | ||
319 | (apply main (cdr (command-line))) |