123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841 |
- #!@GUILE@ \
- --no-auto-compile -s
- !#
- ;;; GNU Guix --- Functional package management for GNU
- ;;; Copyright © 2022, 2023 Ricardo Wurmus <rekado@elephly.net>
- ;;; Copyright © 2022 Mathieu Othacehe <othacehe@gnu.org>
- ;;; Copyright © 2022, 2023 Maxim Cournoyer <maxim.cournoyer@gmail.com>
- ;;; Copyright © 2022 Simon Tournier <zimon.toutoune@gmail.com>
- ;;;
- ;;; This file is part of GNU Guix.
- ;;;
- ;;; GNU Guix is free software; you can redistribute it and/or modify it
- ;;; under the terms of the GNU General Public License as published by
- ;;; the Free Software Foundation; either version 3 of the License, or (at
- ;;; your option) any later version.
- ;;;
- ;;; GNU Guix is distributed in the hope that it will be useful, but
- ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
- ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- ;;; GNU General Public License for more details.
- ;;;
- ;;; You should have received a copy of the GNU General Public License
- ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
- ;;; Commentary:
- ;; This code defines development teams and team members, as well as their
- ;; scope.
- ;;; Code:
- (use-modules (srfi srfi-1)
- (srfi srfi-9)
- (srfi srfi-26)
- (ice-9 format)
- (ice-9 regex)
- (ice-9 match)
- (ice-9 rdelim)
- (guix ui)
- (git))
- (define-record-type <regexp*>
- (%make-regexp* pat flag rx)
- regexp*?
- (pat regexp*-pattern)
- (flag regexp*-flag)
- (rx regexp*-rx))
- ;;; Work around regexp implementation.
- ;;; This record allows to track the regexp pattern and then display it.
- (define* (make-regexp* pat #:optional (flag regexp/extended))
- "Alternative to `make-regexp' producing annotated <regexp*> objects."
- (%make-regexp* pat flag (make-regexp pat flag)))
- (define (regexp*-exec rx* str)
- "Execute the RX* regexp, a <regexp*> object."
- (regexp-exec (regexp*-rx rx*) str))
- (define-record-type <team>
- (make-team id name description members scope)
- team?
- (id team-id)
- (name team-name)
- (description team-description)
- (members team-members set-team-members!)
- (scope team-scope))
- (define-record-type <person>
- (make-person name email)
- person?
- (name person-name)
- (email person-email))
- (define* (person name #:optional email)
- (make-person name email))
- (define* (team id #:key name description (members '())
- (scope '()))
- (make-team id
- (or name (symbol->string id))
- description
- members
- scope))
- (define %teams
- (make-hash-table))
- (define-syntax define-team
- (lambda (x)
- (syntax-case x ()
- ((_ id value)
- #`(begin
- (define-public id value)
- (hash-set! %teams 'id id))))))
- (define-syntax-rule (define-member person teams ...)
- (let ((p person))
- (for-each (lambda (team-id)
- (let ((team
- (hash-ref %teams team-id
- (lambda ()
- (error (format #false
- "Unknown team ~a for ~a~%"
- team-id p))))))
- (set-team-members!
- team (cons p (team-members team)))))
- (quote (teams ...)))))
- (define-team python
- (team 'python
- #:name "Python team"
- #:description
- "Python, Python packages, the \"pypi\" importer, and the python-build-system."
- #:scope
- (list "gnu/packages/django.scm"
- "gnu/packages/jupyter.scm"
- ;; Match haskell.scm and haskell-*.scm.
- (make-regexp* "^gnu/packages/python(-.+|)\\.scm$")
- "gnu/packages/sphinx.scm"
- "gnu/packages/tryton.scm"
- "guix/build/pyproject-build-system.scm"
- "guix/build-system/pyproject.scm"
- "guix/build/python-build-system.scm"
- "guix/build-system/python.scm"
- "guix/import/pypi.scm"
- "guix/scripts/import/pypi.scm"
- "tests/pypi.scm")))
- (define-team haskell
- (team 'haskell
- #:name "Haskell team"
- #:description
- "GHC, Hugs, Haskell packages, the \"hackage\" and \"stackage\" importers, and
- the haskell-build-system."
- #:scope
- (list "gnu/packages/dhall.scm"
- ;; Match haskell.scm and haskell-*.scm.
- (make-regexp* "^gnu/packages/haskell(-.+|)\\.scm$")
- "gnu/packages/purescript.scm"
- "guix/build/haskell-build-system.scm"
- "guix/build-system/haskell.scm"
- "guix/import/cabal.scm"
- "guix/import/hackage.scm"
- "guix/import/stackage.scm"
- "guix/scripts/import/hackage.scm")))
- (define-team qt
- (team 'qt
- #:name "Qt team"
- #:description
- "The Qt toolkit/library and the qt-build-system,
- as well as some packages using Qt."
- #:scope (list "gnu/packages/qt.scm"
- "guix/build-system/qt.scm"
- "guix/build/qt-build-system.scm"
- "guix/build/qt-utils.scm")))
- (define-team r
- (team 'r
- #:name "R team"
- #:description
- "The R language, CRAN and Bioconductor repositories, the \"cran\" importer,
- and the r-build-system."
- #:scope (list "gnu/packages/bioconductor.scm"
- "gnu/packages/cran.scm"
- "guix/build/r-build-system.scm"
- "guix/build-system/r.scm"
- "guix/import/cran.scm"
- "guix/scripts/import/cran.scm"
- "tests/cran.scm")))
- (define-team telephony
- (team 'telephony
- #:name "Telephony team"
- #:description
- "Telephony packages and services such as Jami, Linphone, etc."
- #:scope (list "gnu/build/jami-service.scm"
- "gnu/packages/jami.scm"
- "gnu/packages/linphone.scm"
- "gnu/packages/telephony.scm"
- "gnu/services/telephony.scm"
- "gnu/tests/data/jami-dummy-account.dat"
- "gnu/tests/telephony.scm"
- "tests/services/telephony.scm")))
- (define-team tex
- (team 'tex
- #:name "TeX team"
- #:description
- "TeX, LaTeX, XeLaTeX, LuaTeX, TeXLive, the texlive-build-system, and
- the \"texlive\" importer."
- #:scope (list "gnu/packages/tex.scm"
- "gnu/packages/texlive.scm"
- "guix/build/texlive-build-system.scm"
- "guix/build-system/texlive.scm"
- "guix/import/texlive.scm"
- "guix/scripts/import/texlive.scm"
- "tests/texlive.scm")))
- (define-team julia
- (team 'julia
- #:name "Julia team"
- #:description
- "The Julia language, Julia packages, and the julia-build-system."
- #:scope (list (make-regexp* "^gnu/packages/julia(-.+|)\\.scm$")
- "guix/build/julia-build-system.scm"
- "guix/build-system/julia.scm")))
- (define-team ocaml
- (team 'ocaml
- #:name "OCaml and Dune team"
- #:description
- "The OCaml language, the Dune build system, OCaml packages, the \"opam\"
- importer, and the ocaml-build-system."
- #:scope
- (list "gnu/packages/ocaml.scm"
- "gnu/packages/coq.scm"
- "guix/build/ocaml-build-system.scm"
- "guix/build/dune-build-system.scm"
- "guix/build-system/ocaml.scm"
- "guix/build-system/dune.scm"
- "guix/import/opam.scm"
- "guix/scripts/import/opam.scm"
- "tests/opam.scm")))
- (define-team java
- (team 'java
- #:name "Java and Maven team"
- #:description
- "The JDK and JRE, the Maven build system, Java packages, the ant-build-system,
- and the maven-build-system."
- #:scope
- (list ;; Match java.scm and java-*.scm.
- (make-regexp* "^gnu/packages/java(-.+|)\\.scm$")
- ;; Match maven.scm and maven-*.scm
- (make-regexp* "^gnu/packages/maven(-.+|)\\.scm$")
- "guix/build/ant-build-system.scm"
- "guix/build/java-utils.scm"
- "guix/build/maven-build-system.scm"
- ;; The maven directory
- (make-regexp* "^guix/build/maven/")
- "guix/build-system/ant.scm"
- "guix/build-system/maven.scm")))
- (define-team science
- (team 'science
- #:name "Science team"
- #:description "The main science disciplines and fields related
- packages (e.g. Astronomy, Chemistry, Math, Physics etc.)"
- #:scope (list "gnu/packages/algebra.scm"
- "gnu/packages/astronomy.scm"
- "gnu/packages/geo.scm"
- "gnu/packages/chemistry.scm"
- "gnu/packages/maths.scm")))
- (define-team emacs
- (team 'emacs
- #:name "Emacs team"
- #:description "The extensible, customizable text editor and its
- ecosystem."
- #:scope (list "gnu/packages/aux-files/emacs/guix-emacs.el"
- (make-regexp* "^gnu/packages/emacs(-.+|)\\.scm$")
- "gnu/packages/tree-sitter.scm"
- "guix/build/emacs-build-system.scm"
- "guix/build/emacs-utils.scm"
- "guix/build-system/emacs.scm"
- "guix/import/elpa.scm"
- "guix/scripts/import/elpa.scm"
- "tests/elpa.scm")))
- (define-team lisp
- (team 'lisp
- #:name "Lisp team"
- #:description
- "Common Lisp and similar languages, Common Lisp packages and the
- asdf-build-system."
- #:scope (list (make-regexp* "^gnu/packages/lisp(-.+|)\\.scm$")
- "guix/build/asdf-build-system.scm"
- "guix/build/lisp-utils.scm"
- "guix/build-system/asdf.scm")))
- (define-team ruby
- (team 'ruby
- #:name "Ruby team"
- #:scope (list "gnu/packages/ruby.scm"
- "guix/build/ruby-build-system.scm"
- "guix/build-system/ruby.scm"
- "guix/import/gem.scm"
- "guix/scripts/import/gem.scm"
- "tests/gem.scm")))
- (define-team go
- (team 'go
- #:name "Go team"
- #:scope (list "gnu/packages/golang.scm"
- "guix/build/go-build-system.scm"
- "guix/build-system/go.scm"
- "guix/import/go.scm"
- "guix/scripts/import/go.scm"
- "tests/go.scm")))
- (define-team bootstrap
- (team 'bootstrap
- #:name "Bootstrap"
- #:scope (list "gnu/packages/mes.scm")))
- (define-team embedded
- (team 'embedded
- #:name "Embedded"
- #:scope (list "gnu/packages/bootloaders.scm"
- "gnu/packages/firmware.scm")))
- (define-team rust
- (team 'rust
- #:name "Rust"
- #:scope (list (make-regexp* "^gnu/packages/(crates|rust)(-.+|)\\.scm$")
- "gnu/packages/sequoia.scm"
- "guix/build/cargo-build-system.scm"
- "guix/build/cargo-utils.scm"
- "guix/build-system/cargo.scm"
- "guix/import/crate.scm"
- "guix/scripts/import/crate.scm"
- "tests/crate.scm")))
- (define-team kernel
- (team 'kernel
- #:name "Linux-libre kernel team"
- #:scope (list "gnu/build/linux-modules.scm"
- "gnu/packages/linux.scm"
- "gnu/tests/linux-modules.scm"
- "guix/build/linux-module-build-system.scm"
- "guix/build-system/linux-module.scm")))
- (define-team core
- (team 'core
- #:name "Core / Tools / Internals"
- #:scope
- (list "guix/avahi.scm"
- "guix/base16.scm"
- "guix/base32.scm"
- "guix/base64.scm"
- "guix/bzr-download.scm"
- "guix/cache.scm"
- "guix/channels.scm"
- "guix/ci.scm"
- "guix/colors.scm"
- "guix/combinators.scm"
- "guix/config.scm"
- "guix/cpio.scm"
- "guix/cpu.scm"
- "guix/cve.scm"
- "guix/cvs-download.scm"
- "guix/deprecation.scm"
- "guix/derivations.scm"
- "guix/describe.scm"
- "guix/diagnostics.scm"
- "guix/discovery.scm"
- "guix/docker.scm"
- "guix/download.scm"
- "guix/elf.scm"
- "guix/ftp-client.scm"
- "guix/gexp.scm"
- "guix/git-authenticate.scm"
- "guix/git-download.scm"
- "guix/git.scm"
- "guix/glob.scm"
- "guix/gnu-maintenance.scm"
- "guix/gnupg.scm"
- "guix/grafts.scm"
- "guix/graph.scm"
- "guix/hash.scm"
- "guix/hg-download.scm"
- "guix/http-client.scm"
- "guix/i18n.scm"
- "guix/inferior.scm"
- "guix/ipfs.scm"
- "guix/least-authority.scm"
- "guix/licenses.scm"
- "guix/lint.scm"
- "guix/man-db.scm"
- "guix/memoization.scm"
- "guix/modules.scm"
- "guix/monad-repl.scm"
- "guix/monads.scm"
- "guix/narinfo.scm"
- "guix/nar.scm"
- "guix/openpgp.scm"
- "guix/packages.scm"
- "guix/pki.scm"
- "guix/platform.scm"
- "guix/profiles.scm"
- "guix/profiling.scm"
- "guix/progress.scm"
- "guix/quirks.scm"
- "guix/read-print.scm"
- "guix/records.scm"
- "guix/remote.scm"
- "guix/repl.scm"
- "guix/search-paths.scm"
- "guix/self.scm"
- "guix/serialization.scm"
- "guix/sets.scm"
- "guix/ssh.scm"
- "guix/status.scm"
- "guix/store.scm"
- "guix/substitutes.scm"
- "guix/svn-download.scm"
- "guix/swh.scm"
- "guix/tests.scm"
- "guix/transformations.scm"
- "guix/ui.scm"
- "guix/upstream.scm"
- "guix/utils.scm"
- "guix/workers.scm"
- (make-regexp* "^guix/platforms/")
- (make-regexp* "^guix/scripts/")
- (make-regexp* "^guix/store/"))))
- (define-team games
- (team 'games
- #:name "Games and Toys"
- #:description "Packaging programs for amusement."
- #:scope (list "gnu/packages/games.scm"
- "gnu/packages/game-development.scm"
- "gnu/packages/minetest.scm"
- "gnu/packages/esolangs.scm" ; granted, rather niche
- "gnu/packages/motti.scm"
- "guix/build/minetest-build-system.scm")))
- (define-team localization
- (team 'localization
- #:name "Localization (l10n) team"
- #:description
- "Localization of your system to specific languages."
- #:scope (list "gnu/packages/anthy.scm"
- "gnu/packages/fcitx5.scm"
- "gnu/packages/fcitx.scm"
- "gnu/packages/fonts.scm"
- "gnu/packages/ibus.scm")))
- (define-team translations
- (team 'translations
- #:name "Translations"
- #:scope (list "etc/news.scm"
- (make-regexp* "^po/"))))
- (define-team installer
- (team 'installer
- #:name "Installer script and system installer"
- #:scope (list (make-regexp* "^gnu/installer(\\.scm$|/)"))))
- (define-team home
- (team 'home
- #:name "Team for \"Guix Home\""
- #:scope (list (make-regexp* "^(gnu|guix/scripts)/home(\\.scm$|/)")
- "tests/guix-home.sh"
- "tests/home-import.scm"
- "tests/home-services.scm")))
- (define-team mentors
- (team 'mentors
- #:name "Mentors"
- #:description
- "A group of mentors who chaperone contributions by newcomers."))
- (define-team mozilla
- (team 'mozilla
- #:name "Mozilla"
- #:description
- "Taking care about Icecat and Icedove, built from Mozilla Firefox
- and Thunderbird."
- #:scope (list "gnu/packages/gnuzilla.scm")))
- (define-team racket
- (team 'racket
- #:name "Racket team"
- #:description
- "The Racket language and Racket-based languages, Racket packages,
- Racket's variant of Chez Scheme, and development of a Racket build system and
- importer."
- #:scope (list "gnu/packages/chez.scm"
- "gnu/packages/racket.scm")))
- (define-team reproduciblebuilds
- (team 'reproduciblebuilds
- #:name "Reproducible Builds team"
- #:description
- "Reproducible Builds tooling and issues that affect any guix packages."
- #:scope (list "gnu/packages/diffoscope.scm")))
- (define-team gnome
- (team 'gnome
- #:name "Gnome team"
- #:description
- "The Gnome desktop environment, along with core technologies such as
- GLib/GIO, GTK, GStreamer and Webkit."
- #:scope (list "gnu/packages/glib.scm"
- "gnu/packages/gstreamer.scm"
- "gnu/packages/gtk.scm"
- "gnu/packages/gnome.scm"
- "gnu/packages/gnome-xyz.scm"
- "gnu/packages/webkit.scm"
- "guix/build/glib-or-gtk-build-system.scm"
- "guix/build/meson-build-system.scm")))
- (define-team xfce
- (team 'xfce
- #:name "Xfce team"
- #:description "Xfce desktop environment."
- #:scope (list "gnu/packages/xfce.scm")))
- (define-team lxqt
- (team 'lxqt
- #:name "LXQt team"
- #:description "LXQt desktop environment."
- #:scope (list "gnu/packages/lxqt.scm"
- "gnu/packages/qt.scm")))
- (define-member (person "Eric Bavier"
- "bavier@posteo.net")
- science)
- (define-member (person "Lars-Dominik Braun"
- "lars@6xq.net")
- python haskell)
- (define-member (person "Jonathan Brielmaier"
- "jonathan.brielmaier@web.de")
- mozilla)
- (define-member (person "Ludovic Courtès"
- "ludo@gnu.org")
- core home bootstrap installer mentors)
- (define-member (person "Andreas Enge"
- "andreas@enge.fr")
- lxqt science tex)
- (define-member (person "Tobias Geerinckx-Rice"
- "me@tobias.gr")
- core kernel mentors)
- (define-member (person "Björn Höfling"
- "bjoern.hoefling@bjoernhoefling.de")
- java)
- (define-member (person "Leo Famulari"
- "leo@famulari.name")
- kernel)
- (define-member (person "Efraim Flashner"
- "efraim@flashner.co.il")
- embedded bootstrap julia rust science)
- (define-member (person "jgart"
- "jgart@dismail.de")
- python lisp mentors)
- (define-member (person "Guillaume Le Vaillant"
- "glv@posteo.net")
- lisp)
- (define-member (person "Julien Lepiller"
- "julien@lepiller.eu")
- java ocaml translations)
- (define-member (person "Philip McGrath"
- "philip@philipmcgrath.com")
- racket)
- (define-member (person "Mathieu Othacehe"
- "othacehe@gnu.org")
- core installer mentors)
- (define-member (person "Florian Pelz"
- "pelzflorian@pelzflorian.de")
- translations)
- (define-member (person "Liliana Marie Prikler"
- "liliana.prikler@gmail.com")
- emacs games gnome)
- (define-member (person "Ricardo Wurmus"
- "rekado@elephly.net")
- r core mentors tex)
- (define-member (person "Christopher Baines"
- "guix@cbaines.net")
- core mentors ruby)
- (define-member (person "Andrew Tropin"
- "andrew@trop.in")
- home emacs)
- (define-member (person "pukkamustard"
- "pukkamustard@posteo.net")
- ocaml)
- (define-member (person "Josselin Poiret"
- "dev@jpoiret.xyz")
- core installer)
- (define-member (person "("
- "paren@disroot.org")
- home mentors)
- (define-member (person "Simon Tournier"
- "zimon.toutoune@gmail.com")
- julia core mentors)
- (define-member (person "Raghav Gururajan"
- "rg@raghavgururajan.name")
- gnome mentors)
- (define-member (person "宋文武"
- "iyzsong@envs.net")
- games localization lxqt xfce)
- (define-member (person "Vagrant Cascadian"
- "vagrant@debian.org")
- embedded)
- (define-member (person "Vagrant Cascadian"
- "vagrant@reproducible-builds.org")
- reproduciblebuilds)
- (define-member (person "Zhu Zihao"
- "all_but_last@163.com")
- localization xfce)
- (define-member (person "Maxim Cournoyer"
- "maxim.cournoyer@gmail.com")
- gnome qt telephony)
- (define-member (person "Katherine Cox-Buday"
- "cox.katherine.e+guix@gmail.com")
- emacs go lisp)
- (define (find-team name)
- (or (hash-ref %teams (string->symbol name))
- (error (format #false
- "no such team: ~a~%" name))))
- (define (find-team-by-scope files)
- "Return the team(s) which scope matches at least one of the FILES, as list
- of file names as string."
- (hash-fold
- (lambda (key team acc)
- (if (any (lambda (file)
- (any (match-lambda
- ((? string? scope)
- (string=? scope file))
- ((? regexp*? scope)
- (regexp*-exec scope file)))
- (team-scope team)))
- files)
- (cons team acc)
- acc))
- '()
- %teams))
- (define (cc . teams)
- "Return arguments for `git send-email' to notify the members of the given
- TEAMS when a patch is received by Debbugs."
- (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 #:key (prefix ""))
- "Print the members of the given TEAM."
- (for-each (lambda (member)
- (format #t "~a~a~%" prefix (member->string member)))
- (sort-members (team-members team))))
- (define (print-team team)
- "Print TEAM, a <team> record object."
- (format #t
- "\
- id: ~a
- name: ~a
- description: ~a
- ~amembers:
- "
- (team-id team)
- (team-name team)
- (or (and=> (team-description team)
- (lambda (text)
- (string->recutils
- (fill-paragraph text (%text-width)
- (string-length "description: ")))))
- "<none>")
- (match (team-scope team)
- (() "")
- (scope (format #f "scope:~%~{+ ~a~^~%~}~%"
- (sort (map (match-lambda
- ((? regexp*? rx)
- (regexp*-pattern rx))
- (item item))
- scope)
- string<?)))))
- (list-members team #:prefix "+ ")
- (newline))
- (define (sort-teams teams)
- "Sort TEAMS, a list of <team> record objects."
- (sort teams
- (lambda (team1 team2)
- (string<? (symbol->string (team-id team1))
- (symbol->string (team-id team2))))))
- (define* (list-teams #:optional team-names)
- "Print all teams, their scope and their members."
- (for-each print-team
- (sort-teams
- (if team-names
- (map find-team team-names)
- (hash-map->list (lambda (_ value) value) %teams)))))
- (define (diff-revisions rev-start rev-end)
- "Return the list of added, modified or removed files between REV-START
- and REV-END, two git revision strings."
- (let* ((repository (repository-open (getcwd)))
- (commit1 (commit-lookup repository
- (object-id
- (revparse-single repository rev-start))))
- (commit2 (commit-lookup repository
- (object-id
- (revparse-single repository rev-end))))
- (diff (diff-tree-to-tree repository
- (commit-tree commit1)
- (commit-tree commit2)))
- (files '()))
- (diff-foreach
- diff
- (lambda (delta progress)
- (set! files
- (cons (diff-file-path (diff-delta-old-file delta)) files))
- 0)
- (const 0)
- (const 0)
- (const 0))
- files))
- (define (git-patch->commit-id file)
- "Parse the commit ID from the first line of FILE, a patch produced with git."
- (call-with-input-file file
- (lambda (port)
- (let ((m (string-match "^From ([0-9a-f]{40})" (read-line port))))
- (unless m
- (error "invalid patch file:" file))
- (match:substring m 1)))))
- (define (git-patch->revisions file)
- "Return the start and end revisions of FILE, a patch file produced with git."
- (let* ((rev-end (git-patch->commit-id file))
- (rev-start (string-append rev-end "^")))
- (list rev-start rev-end)))
- (define (patch->teams patch-file)
- "Return the name of the teams in scope for the changes in PATCH-FILE."
- (map (compose symbol->string team-id)
- (find-team-by-scope (apply diff-revisions
- (git-patch->revisions patch-file)))))
- (define (main . args)
- (match args
- (("cc" . team-names)
- (apply cc (map find-team team-names)))
- (("cc-members" patch-file)
- (unless (file-exists? patch-file)
- (error "patch file does not exist:" patch-file))
- (apply main "cc-members" (git-patch->revisions patch-file)))
- (("cc-members" rev-start rev-end)
- (apply cc (find-team-by-scope
- (diff-revisions rev-start rev-end))))
- (("cc-members-header-cmd" 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)
- (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)
- (list-teams))
- (("list-members" . team-names)
- (for-each
- (lambda (team-name)
- (list-members (find-team team-name)))
- team-names))
- (("show" . team-names)
- (list-teams team-names))
- (anything
- (format (current-error-port)
- "Usage: etc/teams.scm <command> [<args>]
- Commands:
- cc <team-name>
- get git send-email flags for cc-ing <team-name>
- cc-members <start> <end> | <patch>
- cc teams related to files changed between revisions or in a patch file
- cc-members-header-cmd <patch>
- cc-members variant for use with 'git send-email --header-cmd'
- cc-mentors-header-cmd <patch>
- command to use with 'git send-email --header-cmd' to notify mentors
- list-teams
- list teams and their members
- list-members <team-name>
- list members belonging to <team-name>
- get-maintainer <patch>
- compatibility mode with Linux get_maintainer.pl
- show <team-name>
- display <team-name> properties~%"))))
- (apply main (cdr (command-line)))
|