[bug#57646] [PATCH 1/3] etc: teams: Add scope support.

[Mathieu Othacehe]

Add a scope list to each team.  This list defines all the files and
directories that are mentored by the team.

Also add a cc-members command that takes two Git revision strings as input,
add returns the members that should be CC'ed given the files impacted between
the two revisions.

* etc/teams.scm.in (<team>)[scope]: New field.
(team, list-teams): Adapt those procedures.
(find-team-by-scope, diff-revisions): New procedures.
(main): Add a "cc-members" command.
---
 etc/teams.scm.in | 74 ++++++++++++++++++++++++++++++++++++++++++------
 1 file changed, 65 insertions(+), 9 deletions(-)

diff --git a/etc/teams.scm.in b/etc/teams.scm.in
index 38b7ab8e1d..37937a02ff 100644
--- a/etc/teams.scm.in
+++ b/etc/teams.scm.in
@@ -4,6 +4,7 @@
 
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2022 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2022 Mathieu Othacehe <othacehe@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -22,23 +23,27 @@
 
 ;;; Commentary:
 
-;; This code defines development teams and team members.
+;; 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 match)
-             (guix ui))
+             (guix ui)
+             (git))
 
 (define-record-type <team>
-  (make-team id name description members)
+  (make-team id name description members scope)
   team?
   (id          team-id)
   (name        team-name)
   (description team-description)
-  (members     team-members set-team-members!))
+  (members     team-members set-team-members!)
+  (scope       team-scope))
 
 (define-record-type <person>
   (make-person name email)
@@ -49,11 +54,13 @@ (define-record-type <person>
 (define* (person name #:optional email)
   (make-person name email))
 
-(define* (team id #:key name description (members '()))
+(define* (team id #:key name description (members '())
+               (scope '()))
   (make-team id
              (or name (symbol->string id))
              description
-             members))
+             members
+             scope))
 
 (define %teams
   (make-hash-table))
@@ -268,6 +275,22 @@ (define (find-team 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 (lambda (scope)
+                       ;; XXX: Add regex support?
+                       (string-prefix? 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."
@@ -289,7 +312,7 @@ (define port* (or port (current-output-port)))
    (team-members team)))
 
 (define (list-teams)
-  "Print all teams and their members."
+  "Print all teams, their scope and their members."
   (define port* (current-output-port))
   (define width* (%text-width))
   (hash-for-each
@@ -299,7 +322,7 @@ (define width* (%text-width))
 id: ~a
 name: ~a
 description: ~a
-members:
+~amembers:
 "
              (team-id team)
              (team-name team)
@@ -308,15 +331,48 @@ (define width* (%text-width))
                           (string->recutils
                            (fill-paragraph text width*
                                            (string-length "description: ")))))
-                 "<none>"))
+                 "<none>")
+             (if (not (null? (team-scope team)))
+                 (format #f "scope: ~{~s ~}~%" (team-scope team))
+                 ""))
      (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)
-- 
2.37.2