[bug#58660] [PATCH 1/4] etc: teams: Improve scope display.

[zimoun]

* etc/teams.scm.in (<regexp*>): New record type.
(make-regexp*, regexp-exec*): New procedures.
(python, haskell, julia, java, emacs, rust, core, translations, installer,
home): Use it.
(find-team-by-scope): Use it.
(list-teams): Use it and sort scope files.
---
 etc/teams.scm.in | 62 ++++++++++++++++++++++++++++++++++--------------
 1 file changed, 44 insertions(+), 18 deletions(-)

diff --git a/etc/teams.scm.in b/etc/teams.scm.in
index c27ea5271e..394e4d7d46 100644
--- a/etc/teams.scm.in
+++ b/etc/teams.scm.in
@@ -5,6 +5,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2022 Ricardo Wurmus <rekado@elephly.net>
 ;;; Copyright © 2022 Mathieu Othacehe <othacehe@gnu.org>
+;;; Copyright © 2022 Simon Tournier <zimon.toutoune@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -37,6 +38,25 @@
              (guix ui)
              (git))
 
+;;; Work around regexp implementation.
+;;; This record allows to track the regexp pattern and then display it.
+(define-record-type <regexp*>
+  (regexp* pat flag)
+  regexp*?
+  (pat regexp-pattern*)
+  (flag regexp-flag*))
+
+(define* (make-regexp* pat #:optional flag)
+  (regexp* pat flag))
+
+(define (regexp-exec* rx* str)
+  (let ((rx (make-regexp
+             (regexp-pattern* rx*)
+             (or (regexp-flag* rx*)
+                 regexp/extended))))
+    (regexp-exec rx str)))
+
+
 (define-record-type <team>
   (make-team id name description members scope)
   team?
@@ -97,7 +117,7 @@ (define-team python
         (list "gnu/packages/django.scm"
               "gnu/packages/jupyter.scm"
               ;; Match haskell.scm and haskell-*.scm.
-              (make-regexp "^gnu/packages/python(-.+|)\\.scm$")
+              (make-regexp* "^gnu/packages/python(-.+|)\\.scm$")
               "gnu/packages/sphinx.scm"
               "gnu/packages/tryton.scm"
               "guix/build/python-build-system.scm"
@@ -115,7 +135,7 @@ (define-team haskell
         #:scope
         (list "gnu/packages/dhall.scm"
               ;; Match haskell.scm and haskell-*.scm.
-              (make-regexp "^gnu/packages/haskell(-.+|)\\.scm$")
+              (make-regexp* "^gnu/packages/haskell(-.+|)\\.scm$")
               "gnu/packages/purescript.scm"
               "guix/build/haskell-build-system.scm"
               "guix/build-system/haskell.scm"
@@ -143,7 +163,7 @@ (define-team julia
         #:name "Julia team"
         #:description
         "The Julia language, Julia packages, and the julia-build-system."
-        #:scope (list (make-regexp "^gnu/packages/julia(-.+|)\\.scm$")
+        #:scope (list (make-regexp* "^gnu/packages/julia(-.+|)\\.scm$")
                       "guix/build/julia-build-system.scm"
                       "guix/build-system/julia.scm")))
 
@@ -172,14 +192,14 @@ (define-team java
 and the maven-build-system."
         #:scope
         (list ;; Match java.scm and java-*.scm.
-              (make-regexp "^gnu/packages/java(-.+|)\\.scm$")
+              (make-regexp* "^gnu/packages/java(-.+|)\\.scm$")
               ;; Match maven.scm and maven-*.scm
-              (make-regexp "^gnu/packages/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/")
+              (make-regexp* "^guix/build/maven/")
               "guix/build-system/ant.scm"
               "guix/build-system/maven.scm")))
 
@@ -192,7 +212,7 @@ (define-team emacs
         #:name "Emacs team"
         #:description "The extensible, customizable text editor and its
 ecosystem."
-        #:scope (list (make-regexp "^gnu/packages/emacs(-.+|)\\.scm$")
+        #:scope (list (make-regexp* "^gnu/packages/emacs(-.+|)\\.scm$")
                       "guix/build/emacs-build-system.scm"
                       "guix/build/emacs-utils.scm"
                       "guix/build-system/emacs.scm"
@@ -206,7 +226,7 @@ (define-team lisp
         #:description
         "Common Lisp and similar languages, Common Lisp packages and the
 asdf-build-system."
-        #:scope (list (make-regexp "^gnu/packages/lisp(-.+|)\\.scm$")
+        #:scope (list (make-regexp* "^gnu/packages/lisp(-.+|)\\.scm$")
                       "guix/build/asdf-build-system.scm"
                       "guix/build/lisp-utils.scm"
                       "guix/build-system/asdf.scm")))
@@ -238,7 +258,7 @@ (define-team embedded-bootstrap
 (define-team rust
   (team 'rust
         #:name "Rust"
-        #:scope (list (make-regexp "^gnu/packages/(crates|rust)(-.+|)\\.scm$")
+        #: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"
@@ -336,9 +356,9 @@ (define-team core
               "guix/upstream.scm"
               "guix/utils.scm"
               "guix/workers.scm"
-              (make-regexp "^guix/platforms/")
-              (make-regexp "^guix/scripts/")
-              (make-regexp "^guix/store/"))))
+              (make-regexp* "^guix/platforms/")
+              (make-regexp* "^guix/scripts/")
+              (make-regexp* "^guix/store/"))))
 
 (define-team games
   (team 'games
@@ -355,17 +375,17 @@ (define-team translations
   (team 'translations
         #:name "Translations"
         #:scope (list "etc/news.scm"
-                      (make-regexp "^po/"))))
+                      (make-regexp* "^po/"))))
 
 (define-team installer
   (team 'installer
         #:name "Installer script and system installer"
-        #:scope (list (make-regexp "^gnu/installer(\\.scm$|/)"))))
+        #: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$|/)")
+        #:scope (list (make-regexp* "^(gnu|guix/scripts)/home(\\.scm$|/)")
                       "tests/guix-home.sh"
                       "tests/home-import.scm"
                       "tests/home-services.scm")))
@@ -501,8 +521,8 @@ (define (find-team-by-scope files)
                 (any (match-lambda
                        ((? string? scope)
                         (string=? scope file))
-                       ((? regexp? scope)
-                        (regexp-exec scope file)))
+                       ((? regexp*? scope)
+                        (regexp-exec* scope file)))
                      (team-scope team)))
               files)
          (cons team acc)
@@ -553,7 +573,13 @@ (define width* (%text-width))
                  "<none>")
              (match (team-scope team)
                (() "")
-               (scope (format #f "scope: ~{~s ~}~%" scope))))
+               (scope (format #f "scope: ~{~s ~}~%"
+                              (sort
+                               (map (match-lambda
+                                      ((? regexp*? rx*) (regexp-pattern* rx*))
+                                      ((? string? str) str))
+                                    scope)
+                               string<=?)))))
      (list-members team port* "+ ")
      (newline))
    %teams))
-- 
2.36.0