Package: guix-patches;
Reported by: zimoun <zimon.toutoune <at> gmail.com>
Date: Thu, 20 Oct 2022 13:23:02 UTC
Severity: normal
Tags: moreinfo, patch
Done: Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
Bug is archived. No further changes may be made.
Message #38 received at 58660 <at> debbugs.gnu.org (full text, mbox):
From: zimoun <zimon.toutoune <at> gmail.com> To: 58660 <at> debbugs.gnu.org Cc: othacehe <at> gnu.org, zimoun <zimon.toutoune <at> gmail.com> Subject: [PATCH v2 3/3] etc: teams: Improve display of regular expression in 'scope' field. Date: Thu, 17 Nov 2022 21:28:20 +0100
* 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.
---
etc/teams.scm.in | 59 +++++++++++++++++++++++++++++++++---------------
1 file changed, 41 insertions(+), 18 deletions(-)
diff --git a/etc/teams.scm.in b/etc/teams.scm.in
index 3f90e0e6f2..3bdf91597f 100644
--- a/etc/teams.scm.in
+++ b/etc/teams.scm.in
@@ -38,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?
@@ -98,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/pyproject-build-system.scm"
@@ -118,7 +137,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"
@@ -146,7 +165,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")))
@@ -175,14 +194,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")))
@@ -195,7 +214,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"
@@ -209,7 +228,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")))
@@ -241,7 +260,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"
@@ -339,9 +358,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
@@ -358,17 +377,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")))
@@ -508,8 +527,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)
@@ -568,7 +587,11 @@ (define width* (%text-width))
(string-append fmt str))
(format #f "scope:~%")
(sort
- (map (lambda (scope) (format #f "+ ~a~%" scope)) scope-files)
+ (map (compose (cut format #f "+ ~a~%" <>)
+ (match-lambda
+ ((? regexp*? rx*) (regexp-pattern* rx*))
+ ((? string? str) str)))
+ scope-files)
string<=?)))))
(list-members team port* "+ ")
(newline))
--
2.38.1
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.