#!@GUILE@ \ --no-auto-compile -s !# ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2022 Ricardo Wurmus ;;; Copyright © 2022 Mathieu Othacehe ;;; ;;; 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 . ;;; 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) (guix ui) (git)) (define-record-type (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 (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/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 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 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")) (define-team emacs (team 'emacs #:name "Emacs team" #:description "The extensible, customizable text editor and its ecosystem." #:scope (list (make-regexp "^gnu/packages/emacs(-.+|)\\.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$") "gnu/packages/lisp-xyz.scm" "gnu/packages/lisp-check.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 embedded-bootstrap (team 'embedded-bootstrap #:name "Embedded / Bootstrap")) (define-team rust (team 'rust #:name "Rust" #:scope (list (make-regexp "^gnu/packages/(crates|rust)(-.+|)\\.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 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/racket.scm"))) (define-member (person "Thiago Jung Bauermann" "bauermann@kolabnow.com") embedded-bootstrap translations) (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 embedded-bootstrap mentors) (define-member (person "Andreas Enge" "andreas@enge.fr") science) (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) (define-member (person "Ricardo Wurmus" "rekado@elephly.net") r core mentors) (define-member (person "Christopher Baines" "mail@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 (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." (format #true "~{--add-header=\"X-Debbugs-Cc: ~a\"~^ ~}" (map person-email (delete-duplicates (append-map team-members teams) equal?)))) (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))) (team-members team))) (define (list-teams) "Print all teams, their scope and their members." (define port* (current-output-port)) (define width* (%text-width)) (hash-for-each (lambda (key team) (format port* "\ 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 width* (string-length "description: "))))) "") (match (team-scope team) (() "") (scope (format #f "scope: ~{~s ~}~%" scope)))) (list-members team port* "+ ") (newline)) %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 (main . args) (match args (("cc" . team-names) (apply cc (map find-team team-names))) (("cc-members" rev-start rev-end) (apply cc (find-team-by-scope (diff-revisions rev-start rev-end)))) (("list-teams" . args) (list-teams)) (("list-members" . team-names) (for-each (lambda (team-name) (list-members (find-team team-name))) team-names)) (anything (format (current-error-port) "Usage: etc/teams.scm [] Commands: cc get git send-email flags for cc-ing cc-members cc teams related to files changed between revisions list-teams list teams and their members list-members list members belonging to ~%")))) (apply main (cdr (command-line)))