teams.scm.in 28 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841
  1. #!@GUILE@ \
  2. --no-auto-compile -s
  3. !#
  4. ;;; GNU Guix --- Functional package management for GNU
  5. ;;; Copyright © 2022, 2023 Ricardo Wurmus <rekado@elephly.net>
  6. ;;; Copyright © 2022 Mathieu Othacehe <othacehe@gnu.org>
  7. ;;; Copyright © 2022, 2023 Maxim Cournoyer <maxim.cournoyer@gmail.com>
  8. ;;; Copyright © 2022 Simon Tournier <zimon.toutoune@gmail.com>
  9. ;;;
  10. ;;; This file is part of GNU Guix.
  11. ;;;
  12. ;;; GNU Guix is free software; you can redistribute it and/or modify it
  13. ;;; under the terms of the GNU General Public License as published by
  14. ;;; the Free Software Foundation; either version 3 of the License, or (at
  15. ;;; your option) any later version.
  16. ;;;
  17. ;;; GNU Guix is distributed in the hope that it will be useful, but
  18. ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  19. ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  20. ;;; GNU General Public License for more details.
  21. ;;;
  22. ;;; You should have received a copy of the GNU General Public License
  23. ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
  24. ;;; Commentary:
  25. ;; This code defines development teams and team members, as well as their
  26. ;; scope.
  27. ;;; Code:
  28. (use-modules (srfi srfi-1)
  29. (srfi srfi-9)
  30. (srfi srfi-26)
  31. (ice-9 format)
  32. (ice-9 regex)
  33. (ice-9 match)
  34. (ice-9 rdelim)
  35. (guix ui)
  36. (git))
  37. (define-record-type <regexp*>
  38. (%make-regexp* pat flag rx)
  39. regexp*?
  40. (pat regexp*-pattern)
  41. (flag regexp*-flag)
  42. (rx regexp*-rx))
  43. ;;; Work around regexp implementation.
  44. ;;; This record allows to track the regexp pattern and then display it.
  45. (define* (make-regexp* pat #:optional (flag regexp/extended))
  46. "Alternative to `make-regexp' producing annotated <regexp*> objects."
  47. (%make-regexp* pat flag (make-regexp pat flag)))
  48. (define (regexp*-exec rx* str)
  49. "Execute the RX* regexp, a <regexp*> object."
  50. (regexp-exec (regexp*-rx rx*) str))
  51. (define-record-type <team>
  52. (make-team id name description members scope)
  53. team?
  54. (id team-id)
  55. (name team-name)
  56. (description team-description)
  57. (members team-members set-team-members!)
  58. (scope team-scope))
  59. (define-record-type <person>
  60. (make-person name email)
  61. person?
  62. (name person-name)
  63. (email person-email))
  64. (define* (person name #:optional email)
  65. (make-person name email))
  66. (define* (team id #:key name description (members '())
  67. (scope '()))
  68. (make-team id
  69. (or name (symbol->string id))
  70. description
  71. members
  72. scope))
  73. (define %teams
  74. (make-hash-table))
  75. (define-syntax define-team
  76. (lambda (x)
  77. (syntax-case x ()
  78. ((_ id value)
  79. #`(begin
  80. (define-public id value)
  81. (hash-set! %teams 'id id))))))
  82. (define-syntax-rule (define-member person teams ...)
  83. (let ((p person))
  84. (for-each (lambda (team-id)
  85. (let ((team
  86. (hash-ref %teams team-id
  87. (lambda ()
  88. (error (format #false
  89. "Unknown team ~a for ~a~%"
  90. team-id p))))))
  91. (set-team-members!
  92. team (cons p (team-members team)))))
  93. (quote (teams ...)))))
  94. (define-team python
  95. (team 'python
  96. #:name "Python team"
  97. #:description
  98. "Python, Python packages, the \"pypi\" importer, and the python-build-system."
  99. #:scope
  100. (list "gnu/packages/django.scm"
  101. "gnu/packages/jupyter.scm"
  102. ;; Match haskell.scm and haskell-*.scm.
  103. (make-regexp* "^gnu/packages/python(-.+|)\\.scm$")
  104. "gnu/packages/sphinx.scm"
  105. "gnu/packages/tryton.scm"
  106. "guix/build/pyproject-build-system.scm"
  107. "guix/build-system/pyproject.scm"
  108. "guix/build/python-build-system.scm"
  109. "guix/build-system/python.scm"
  110. "guix/import/pypi.scm"
  111. "guix/scripts/import/pypi.scm"
  112. "tests/pypi.scm")))
  113. (define-team haskell
  114. (team 'haskell
  115. #:name "Haskell team"
  116. #:description
  117. "GHC, Hugs, Haskell packages, the \"hackage\" and \"stackage\" importers, and
  118. the haskell-build-system."
  119. #:scope
  120. (list "gnu/packages/dhall.scm"
  121. ;; Match haskell.scm and haskell-*.scm.
  122. (make-regexp* "^gnu/packages/haskell(-.+|)\\.scm$")
  123. "gnu/packages/purescript.scm"
  124. "guix/build/haskell-build-system.scm"
  125. "guix/build-system/haskell.scm"
  126. "guix/import/cabal.scm"
  127. "guix/import/hackage.scm"
  128. "guix/import/stackage.scm"
  129. "guix/scripts/import/hackage.scm")))
  130. (define-team qt
  131. (team 'qt
  132. #:name "Qt team"
  133. #:description
  134. "The Qt toolkit/library and the qt-build-system,
  135. as well as some packages using Qt."
  136. #:scope (list "gnu/packages/qt.scm"
  137. "guix/build-system/qt.scm"
  138. "guix/build/qt-build-system.scm"
  139. "guix/build/qt-utils.scm")))
  140. (define-team r
  141. (team 'r
  142. #:name "R team"
  143. #:description
  144. "The R language, CRAN and Bioconductor repositories, the \"cran\" importer,
  145. and the r-build-system."
  146. #:scope (list "gnu/packages/bioconductor.scm"
  147. "gnu/packages/cran.scm"
  148. "guix/build/r-build-system.scm"
  149. "guix/build-system/r.scm"
  150. "guix/import/cran.scm"
  151. "guix/scripts/import/cran.scm"
  152. "tests/cran.scm")))
  153. (define-team telephony
  154. (team 'telephony
  155. #:name "Telephony team"
  156. #:description
  157. "Telephony packages and services such as Jami, Linphone, etc."
  158. #:scope (list "gnu/build/jami-service.scm"
  159. "gnu/packages/jami.scm"
  160. "gnu/packages/linphone.scm"
  161. "gnu/packages/telephony.scm"
  162. "gnu/services/telephony.scm"
  163. "gnu/tests/data/jami-dummy-account.dat"
  164. "gnu/tests/telephony.scm"
  165. "tests/services/telephony.scm")))
  166. (define-team tex
  167. (team 'tex
  168. #:name "TeX team"
  169. #:description
  170. "TeX, LaTeX, XeLaTeX, LuaTeX, TeXLive, the texlive-build-system, and
  171. the \"texlive\" importer."
  172. #:scope (list "gnu/packages/tex.scm"
  173. "gnu/packages/texlive.scm"
  174. "guix/build/texlive-build-system.scm"
  175. "guix/build-system/texlive.scm"
  176. "guix/import/texlive.scm"
  177. "guix/scripts/import/texlive.scm"
  178. "tests/texlive.scm")))
  179. (define-team julia
  180. (team 'julia
  181. #:name "Julia team"
  182. #:description
  183. "The Julia language, Julia packages, and the julia-build-system."
  184. #:scope (list (make-regexp* "^gnu/packages/julia(-.+|)\\.scm$")
  185. "guix/build/julia-build-system.scm"
  186. "guix/build-system/julia.scm")))
  187. (define-team ocaml
  188. (team 'ocaml
  189. #:name "OCaml and Dune team"
  190. #:description
  191. "The OCaml language, the Dune build system, OCaml packages, the \"opam\"
  192. importer, and the ocaml-build-system."
  193. #:scope
  194. (list "gnu/packages/ocaml.scm"
  195. "gnu/packages/coq.scm"
  196. "guix/build/ocaml-build-system.scm"
  197. "guix/build/dune-build-system.scm"
  198. "guix/build-system/ocaml.scm"
  199. "guix/build-system/dune.scm"
  200. "guix/import/opam.scm"
  201. "guix/scripts/import/opam.scm"
  202. "tests/opam.scm")))
  203. (define-team java
  204. (team 'java
  205. #:name "Java and Maven team"
  206. #:description
  207. "The JDK and JRE, the Maven build system, Java packages, the ant-build-system,
  208. and the maven-build-system."
  209. #:scope
  210. (list ;; Match java.scm and java-*.scm.
  211. (make-regexp* "^gnu/packages/java(-.+|)\\.scm$")
  212. ;; Match maven.scm and maven-*.scm
  213. (make-regexp* "^gnu/packages/maven(-.+|)\\.scm$")
  214. "guix/build/ant-build-system.scm"
  215. "guix/build/java-utils.scm"
  216. "guix/build/maven-build-system.scm"
  217. ;; The maven directory
  218. (make-regexp* "^guix/build/maven/")
  219. "guix/build-system/ant.scm"
  220. "guix/build-system/maven.scm")))
  221. (define-team science
  222. (team 'science
  223. #:name "Science team"
  224. #:description "The main science disciplines and fields related
  225. packages (e.g. Astronomy, Chemistry, Math, Physics etc.)"
  226. #:scope (list "gnu/packages/algebra.scm"
  227. "gnu/packages/astronomy.scm"
  228. "gnu/packages/geo.scm"
  229. "gnu/packages/chemistry.scm"
  230. "gnu/packages/maths.scm")))
  231. (define-team emacs
  232. (team 'emacs
  233. #:name "Emacs team"
  234. #:description "The extensible, customizable text editor and its
  235. ecosystem."
  236. #:scope (list "gnu/packages/aux-files/emacs/guix-emacs.el"
  237. (make-regexp* "^gnu/packages/emacs(-.+|)\\.scm$")
  238. "gnu/packages/tree-sitter.scm"
  239. "guix/build/emacs-build-system.scm"
  240. "guix/build/emacs-utils.scm"
  241. "guix/build-system/emacs.scm"
  242. "guix/import/elpa.scm"
  243. "guix/scripts/import/elpa.scm"
  244. "tests/elpa.scm")))
  245. (define-team lisp
  246. (team 'lisp
  247. #:name "Lisp team"
  248. #:description
  249. "Common Lisp and similar languages, Common Lisp packages and the
  250. asdf-build-system."
  251. #:scope (list (make-regexp* "^gnu/packages/lisp(-.+|)\\.scm$")
  252. "guix/build/asdf-build-system.scm"
  253. "guix/build/lisp-utils.scm"
  254. "guix/build-system/asdf.scm")))
  255. (define-team ruby
  256. (team 'ruby
  257. #:name "Ruby team"
  258. #:scope (list "gnu/packages/ruby.scm"
  259. "guix/build/ruby-build-system.scm"
  260. "guix/build-system/ruby.scm"
  261. "guix/import/gem.scm"
  262. "guix/scripts/import/gem.scm"
  263. "tests/gem.scm")))
  264. (define-team go
  265. (team 'go
  266. #:name "Go team"
  267. #:scope (list "gnu/packages/golang.scm"
  268. "guix/build/go-build-system.scm"
  269. "guix/build-system/go.scm"
  270. "guix/import/go.scm"
  271. "guix/scripts/import/go.scm"
  272. "tests/go.scm")))
  273. (define-team bootstrap
  274. (team 'bootstrap
  275. #:name "Bootstrap"
  276. #:scope (list "gnu/packages/mes.scm")))
  277. (define-team embedded
  278. (team 'embedded
  279. #:name "Embedded"
  280. #:scope (list "gnu/packages/bootloaders.scm"
  281. "gnu/packages/firmware.scm")))
  282. (define-team rust
  283. (team 'rust
  284. #:name "Rust"
  285. #:scope (list (make-regexp* "^gnu/packages/(crates|rust)(-.+|)\\.scm$")
  286. "gnu/packages/sequoia.scm"
  287. "guix/build/cargo-build-system.scm"
  288. "guix/build/cargo-utils.scm"
  289. "guix/build-system/cargo.scm"
  290. "guix/import/crate.scm"
  291. "guix/scripts/import/crate.scm"
  292. "tests/crate.scm")))
  293. (define-team kernel
  294. (team 'kernel
  295. #:name "Linux-libre kernel team"
  296. #:scope (list "gnu/build/linux-modules.scm"
  297. "gnu/packages/linux.scm"
  298. "gnu/tests/linux-modules.scm"
  299. "guix/build/linux-module-build-system.scm"
  300. "guix/build-system/linux-module.scm")))
  301. (define-team core
  302. (team 'core
  303. #:name "Core / Tools / Internals"
  304. #:scope
  305. (list "guix/avahi.scm"
  306. "guix/base16.scm"
  307. "guix/base32.scm"
  308. "guix/base64.scm"
  309. "guix/bzr-download.scm"
  310. "guix/cache.scm"
  311. "guix/channels.scm"
  312. "guix/ci.scm"
  313. "guix/colors.scm"
  314. "guix/combinators.scm"
  315. "guix/config.scm"
  316. "guix/cpio.scm"
  317. "guix/cpu.scm"
  318. "guix/cve.scm"
  319. "guix/cvs-download.scm"
  320. "guix/deprecation.scm"
  321. "guix/derivations.scm"
  322. "guix/describe.scm"
  323. "guix/diagnostics.scm"
  324. "guix/discovery.scm"
  325. "guix/docker.scm"
  326. "guix/download.scm"
  327. "guix/elf.scm"
  328. "guix/ftp-client.scm"
  329. "guix/gexp.scm"
  330. "guix/git-authenticate.scm"
  331. "guix/git-download.scm"
  332. "guix/git.scm"
  333. "guix/glob.scm"
  334. "guix/gnu-maintenance.scm"
  335. "guix/gnupg.scm"
  336. "guix/grafts.scm"
  337. "guix/graph.scm"
  338. "guix/hash.scm"
  339. "guix/hg-download.scm"
  340. "guix/http-client.scm"
  341. "guix/i18n.scm"
  342. "guix/inferior.scm"
  343. "guix/ipfs.scm"
  344. "guix/least-authority.scm"
  345. "guix/licenses.scm"
  346. "guix/lint.scm"
  347. "guix/man-db.scm"
  348. "guix/memoization.scm"
  349. "guix/modules.scm"
  350. "guix/monad-repl.scm"
  351. "guix/monads.scm"
  352. "guix/narinfo.scm"
  353. "guix/nar.scm"
  354. "guix/openpgp.scm"
  355. "guix/packages.scm"
  356. "guix/pki.scm"
  357. "guix/platform.scm"
  358. "guix/profiles.scm"
  359. "guix/profiling.scm"
  360. "guix/progress.scm"
  361. "guix/quirks.scm"
  362. "guix/read-print.scm"
  363. "guix/records.scm"
  364. "guix/remote.scm"
  365. "guix/repl.scm"
  366. "guix/search-paths.scm"
  367. "guix/self.scm"
  368. "guix/serialization.scm"
  369. "guix/sets.scm"
  370. "guix/ssh.scm"
  371. "guix/status.scm"
  372. "guix/store.scm"
  373. "guix/substitutes.scm"
  374. "guix/svn-download.scm"
  375. "guix/swh.scm"
  376. "guix/tests.scm"
  377. "guix/transformations.scm"
  378. "guix/ui.scm"
  379. "guix/upstream.scm"
  380. "guix/utils.scm"
  381. "guix/workers.scm"
  382. (make-regexp* "^guix/platforms/")
  383. (make-regexp* "^guix/scripts/")
  384. (make-regexp* "^guix/store/"))))
  385. (define-team games
  386. (team 'games
  387. #:name "Games and Toys"
  388. #:description "Packaging programs for amusement."
  389. #:scope (list "gnu/packages/games.scm"
  390. "gnu/packages/game-development.scm"
  391. "gnu/packages/minetest.scm"
  392. "gnu/packages/esolangs.scm" ; granted, rather niche
  393. "gnu/packages/motti.scm"
  394. "guix/build/minetest-build-system.scm")))
  395. (define-team localization
  396. (team 'localization
  397. #:name "Localization (l10n) team"
  398. #:description
  399. "Localization of your system to specific languages."
  400. #:scope (list "gnu/packages/anthy.scm"
  401. "gnu/packages/fcitx5.scm"
  402. "gnu/packages/fcitx.scm"
  403. "gnu/packages/fonts.scm"
  404. "gnu/packages/ibus.scm")))
  405. (define-team translations
  406. (team 'translations
  407. #:name "Translations"
  408. #:scope (list "etc/news.scm"
  409. (make-regexp* "^po/"))))
  410. (define-team installer
  411. (team 'installer
  412. #:name "Installer script and system installer"
  413. #:scope (list (make-regexp* "^gnu/installer(\\.scm$|/)"))))
  414. (define-team home
  415. (team 'home
  416. #:name "Team for \"Guix Home\""
  417. #:scope (list (make-regexp* "^(gnu|guix/scripts)/home(\\.scm$|/)")
  418. "tests/guix-home.sh"
  419. "tests/home-import.scm"
  420. "tests/home-services.scm")))
  421. (define-team mentors
  422. (team 'mentors
  423. #:name "Mentors"
  424. #:description
  425. "A group of mentors who chaperone contributions by newcomers."))
  426. (define-team mozilla
  427. (team 'mozilla
  428. #:name "Mozilla"
  429. #:description
  430. "Taking care about Icecat and Icedove, built from Mozilla Firefox
  431. and Thunderbird."
  432. #:scope (list "gnu/packages/gnuzilla.scm")))
  433. (define-team racket
  434. (team 'racket
  435. #:name "Racket team"
  436. #:description
  437. "The Racket language and Racket-based languages, Racket packages,
  438. Racket's variant of Chez Scheme, and development of a Racket build system and
  439. importer."
  440. #:scope (list "gnu/packages/chez.scm"
  441. "gnu/packages/racket.scm")))
  442. (define-team reproduciblebuilds
  443. (team 'reproduciblebuilds
  444. #:name "Reproducible Builds team"
  445. #:description
  446. "Reproducible Builds tooling and issues that affect any guix packages."
  447. #:scope (list "gnu/packages/diffoscope.scm")))
  448. (define-team gnome
  449. (team 'gnome
  450. #:name "Gnome team"
  451. #:description
  452. "The Gnome desktop environment, along with core technologies such as
  453. GLib/GIO, GTK, GStreamer and Webkit."
  454. #:scope (list "gnu/packages/glib.scm"
  455. "gnu/packages/gstreamer.scm"
  456. "gnu/packages/gtk.scm"
  457. "gnu/packages/gnome.scm"
  458. "gnu/packages/gnome-xyz.scm"
  459. "gnu/packages/webkit.scm"
  460. "guix/build/glib-or-gtk-build-system.scm"
  461. "guix/build/meson-build-system.scm")))
  462. (define-team xfce
  463. (team 'xfce
  464. #:name "Xfce team"
  465. #:description "Xfce desktop environment."
  466. #:scope (list "gnu/packages/xfce.scm")))
  467. (define-team lxqt
  468. (team 'lxqt
  469. #:name "LXQt team"
  470. #:description "LXQt desktop environment."
  471. #:scope (list "gnu/packages/lxqt.scm"
  472. "gnu/packages/qt.scm")))
  473. (define-member (person "Eric Bavier"
  474. "bavier@posteo.net")
  475. science)
  476. (define-member (person "Lars-Dominik Braun"
  477. "lars@6xq.net")
  478. python haskell)
  479. (define-member (person "Jonathan Brielmaier"
  480. "jonathan.brielmaier@web.de")
  481. mozilla)
  482. (define-member (person "Ludovic Courtès"
  483. "ludo@gnu.org")
  484. core home bootstrap installer mentors)
  485. (define-member (person "Andreas Enge"
  486. "andreas@enge.fr")
  487. lxqt science tex)
  488. (define-member (person "Tobias Geerinckx-Rice"
  489. "me@tobias.gr")
  490. core kernel mentors)
  491. (define-member (person "Björn Höfling"
  492. "bjoern.hoefling@bjoernhoefling.de")
  493. java)
  494. (define-member (person "Leo Famulari"
  495. "leo@famulari.name")
  496. kernel)
  497. (define-member (person "Efraim Flashner"
  498. "efraim@flashner.co.il")
  499. embedded bootstrap julia rust science)
  500. (define-member (person "jgart"
  501. "jgart@dismail.de")
  502. python lisp mentors)
  503. (define-member (person "Guillaume Le Vaillant"
  504. "glv@posteo.net")
  505. lisp)
  506. (define-member (person "Julien Lepiller"
  507. "julien@lepiller.eu")
  508. java ocaml translations)
  509. (define-member (person "Philip McGrath"
  510. "philip@philipmcgrath.com")
  511. racket)
  512. (define-member (person "Mathieu Othacehe"
  513. "othacehe@gnu.org")
  514. core installer mentors)
  515. (define-member (person "Florian Pelz"
  516. "pelzflorian@pelzflorian.de")
  517. translations)
  518. (define-member (person "Liliana Marie Prikler"
  519. "liliana.prikler@gmail.com")
  520. emacs games gnome)
  521. (define-member (person "Ricardo Wurmus"
  522. "rekado@elephly.net")
  523. r core mentors tex)
  524. (define-member (person "Christopher Baines"
  525. "guix@cbaines.net")
  526. core mentors ruby)
  527. (define-member (person "Andrew Tropin"
  528. "andrew@trop.in")
  529. home emacs)
  530. (define-member (person "pukkamustard"
  531. "pukkamustard@posteo.net")
  532. ocaml)
  533. (define-member (person "Josselin Poiret"
  534. "dev@jpoiret.xyz")
  535. core installer)
  536. (define-member (person "("
  537. "paren@disroot.org")
  538. home mentors)
  539. (define-member (person "Simon Tournier"
  540. "zimon.toutoune@gmail.com")
  541. julia core mentors)
  542. (define-member (person "Raghav Gururajan"
  543. "rg@raghavgururajan.name")
  544. gnome mentors)
  545. (define-member (person "宋文武"
  546. "iyzsong@envs.net")
  547. games localization lxqt xfce)
  548. (define-member (person "Vagrant Cascadian"
  549. "vagrant@debian.org")
  550. embedded)
  551. (define-member (person "Vagrant Cascadian"
  552. "vagrant@reproducible-builds.org")
  553. reproduciblebuilds)
  554. (define-member (person "Zhu Zihao"
  555. "all_but_last@163.com")
  556. localization xfce)
  557. (define-member (person "Maxim Cournoyer"
  558. "maxim.cournoyer@gmail.com")
  559. gnome qt telephony)
  560. (define-member (person "Katherine Cox-Buday"
  561. "cox.katherine.e+guix@gmail.com")
  562. emacs go lisp)
  563. (define (find-team name)
  564. (or (hash-ref %teams (string->symbol name))
  565. (error (format #false
  566. "no such team: ~a~%" name))))
  567. (define (find-team-by-scope files)
  568. "Return the team(s) which scope matches at least one of the FILES, as list
  569. of file names as string."
  570. (hash-fold
  571. (lambda (key team acc)
  572. (if (any (lambda (file)
  573. (any (match-lambda
  574. ((? string? scope)
  575. (string=? scope file))
  576. ((? regexp*? scope)
  577. (regexp*-exec scope file)))
  578. (team-scope team)))
  579. files)
  580. (cons team acc)
  581. acc))
  582. '()
  583. %teams))
  584. (define (cc . teams)
  585. "Return arguments for `git send-email' to notify the members of the given
  586. TEAMS when a patch is received by Debbugs."
  587. (let ((members (append-map team-members teams)))
  588. (unless (null? members)
  589. (format #true "--add-header=\"X-Debbugs-Cc: ~{~a~^, ~}\""
  590. (map person-email (sort-members members))))))
  591. (define (sort-members members)
  592. "Deduplicate and sort MEMBERS alphabetically by their name."
  593. (sort (delete-duplicates members equal?)
  594. (lambda (m1 m2)
  595. (string<? (person-name m1) (person-name m2)))))
  596. (define (member->string member)
  597. "Return the 'email <name>' string representation of MEMBER."
  598. (let* ((name (person-name member))
  599. (quoted-name/maybe (if (string-contains name ",")
  600. (string-append "\"" name "\"")
  601. name)))
  602. (format #false "~a <~a>" quoted-name/maybe (person-email member))))
  603. (define* (list-members team #:key (prefix ""))
  604. "Print the members of the given TEAM."
  605. (for-each (lambda (member)
  606. (format #t "~a~a~%" prefix (member->string member)))
  607. (sort-members (team-members team))))
  608. (define (print-team team)
  609. "Print TEAM, a <team> record object."
  610. (format #t
  611. "\
  612. id: ~a
  613. name: ~a
  614. description: ~a
  615. ~amembers:
  616. "
  617. (team-id team)
  618. (team-name team)
  619. (or (and=> (team-description team)
  620. (lambda (text)
  621. (string->recutils
  622. (fill-paragraph text (%text-width)
  623. (string-length "description: ")))))
  624. "<none>")
  625. (match (team-scope team)
  626. (() "")
  627. (scope (format #f "scope:~%~{+ ~a~^~%~}~%"
  628. (sort (map (match-lambda
  629. ((? regexp*? rx)
  630. (regexp*-pattern rx))
  631. (item item))
  632. scope)
  633. string<?)))))
  634. (list-members team #:prefix "+ ")
  635. (newline))
  636. (define (sort-teams teams)
  637. "Sort TEAMS, a list of <team> record objects."
  638. (sort teams
  639. (lambda (team1 team2)
  640. (string<? (symbol->string (team-id team1))
  641. (symbol->string (team-id team2))))))
  642. (define* (list-teams #:optional team-names)
  643. "Print all teams, their scope and their members."
  644. (for-each print-team
  645. (sort-teams
  646. (if team-names
  647. (map find-team team-names)
  648. (hash-map->list (lambda (_ value) value) %teams)))))
  649. (define (diff-revisions rev-start rev-end)
  650. "Return the list of added, modified or removed files between REV-START
  651. and REV-END, two git revision strings."
  652. (let* ((repository (repository-open (getcwd)))
  653. (commit1 (commit-lookup repository
  654. (object-id
  655. (revparse-single repository rev-start))))
  656. (commit2 (commit-lookup repository
  657. (object-id
  658. (revparse-single repository rev-end))))
  659. (diff (diff-tree-to-tree repository
  660. (commit-tree commit1)
  661. (commit-tree commit2)))
  662. (files '()))
  663. (diff-foreach
  664. diff
  665. (lambda (delta progress)
  666. (set! files
  667. (cons (diff-file-path (diff-delta-old-file delta)) files))
  668. 0)
  669. (const 0)
  670. (const 0)
  671. (const 0))
  672. files))
  673. (define (git-patch->commit-id file)
  674. "Parse the commit ID from the first line of FILE, a patch produced with git."
  675. (call-with-input-file file
  676. (lambda (port)
  677. (let ((m (string-match "^From ([0-9a-f]{40})" (read-line port))))
  678. (unless m
  679. (error "invalid patch file:" file))
  680. (match:substring m 1)))))
  681. (define (git-patch->revisions file)
  682. "Return the start and end revisions of FILE, a patch file produced with git."
  683. (let* ((rev-end (git-patch->commit-id file))
  684. (rev-start (string-append rev-end "^")))
  685. (list rev-start rev-end)))
  686. (define (patch->teams patch-file)
  687. "Return the name of the teams in scope for the changes in PATCH-FILE."
  688. (map (compose symbol->string team-id)
  689. (find-team-by-scope (apply diff-revisions
  690. (git-patch->revisions patch-file)))))
  691. (define (main . args)
  692. (match args
  693. (("cc" . team-names)
  694. (apply cc (map find-team team-names)))
  695. (("cc-members" patch-file)
  696. (unless (file-exists? patch-file)
  697. (error "patch file does not exist:" patch-file))
  698. (apply main "cc-members" (git-patch->revisions patch-file)))
  699. (("cc-members" rev-start rev-end)
  700. (apply cc (find-team-by-scope
  701. (diff-revisions rev-start rev-end))))
  702. (("cc-members-header-cmd" patch-file)
  703. (let* ((teams (map find-team (patch->teams patch-file)))
  704. (members (sort-members (append-map team-members teams))))
  705. (unless (null? members)
  706. (format #true "X-Debbugs-Cc: ~{~a~^, ~}"
  707. (map member->string members)))))
  708. (("cc-mentors-header-cmd" patch-file)
  709. (format #true "X-Debbugs-Cc: ~{~a~^, ~}"
  710. (map member->string
  711. (sort-members (team-members (find-team "mentors"))))))
  712. (("get-maintainer" patch-file)
  713. (apply main "list-members" (patch->teams patch-file)))
  714. (("list-teams" . args)
  715. (list-teams))
  716. (("list-members" . team-names)
  717. (for-each
  718. (lambda (team-name)
  719. (list-members (find-team team-name)))
  720. team-names))
  721. (("show" . team-names)
  722. (list-teams team-names))
  723. (anything
  724. (format (current-error-port)
  725. "Usage: etc/teams.scm <command> [<args>]
  726. Commands:
  727. cc <team-name>
  728. get git send-email flags for cc-ing <team-name>
  729. cc-members <start> <end> | <patch>
  730. cc teams related to files changed between revisions or in a patch file
  731. cc-members-header-cmd <patch>
  732. cc-members variant for use with 'git send-email --header-cmd'
  733. cc-mentors-header-cmd <patch>
  734. command to use with 'git send-email --header-cmd' to notify mentors
  735. list-teams
  736. list teams and their members
  737. list-members <team-name>
  738. list members belonging to <team-name>
  739. get-maintainer <patch>
  740. compatibility mode with Linux get_maintainer.pl
  741. show <team-name>
  742. display <team-name> properties~%"))))
  743. (apply main (cdr (command-line)))