[bug#74979] [PATCH 0/4] scripts: style: Sort more kinds of package

[bug#74979] [PATCH 0/4] scripts: style: Sort more kinds of package

[Herman Rimm via Guix-patches via]

Hello,

The warnings added in [PATCH 4/4] are emitted multiple times.  How
should I prevent that?  Or should I put them behind a --verbose option?

Cheers,
Herman

Herman Rimm (4):
  scripts: style: Refactor order-packages.
  scripts: style: Sort more kinds of package definitions.
  scripts: style: Only sort packages with string literal name.
  scripts: style: Warn about unmatched package definitions.

 guix/scripts/style.scm | 57 ++++++++++++++++++++++--------------------
 1 file changed, 30 insertions(+), 27 deletions(-)


base-commit: 07b4b1d055c36c6c61d39273c26974771dbfe805
-- 
2.45.2

[bug#74979] [PATCH 1/4] scripts: style: Refactor order-packages.

[Herman Rimm via Guix-patches via]

* guix/scripts/style.scm (order-packages): Combine package-name and
package-version procedures into package-fields.
(format-whole-file): Do not sort copyright headers or module definition.

Change-Id: I5507bf8ed221f7017f972f0e0e64d149bea4854b
---
 guix/scripts/style.scm | 36 +++++++++++++++---------------------
 1 file changed, 15 insertions(+), 21 deletions(-)

diff --git a/guix/scripts/style.scm b/guix/scripts/style.scm
index 51234952e9..4b704ddfb7 100644
--- a/guix/scripts/style.scm
+++ b/guix/scripts/style.scm
@@ -43,6 +43,7 @@ (define-module (guix scripts style)
   #:use-module (ice-9 match)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-9)
+  #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-34)
   #:use-module (srfi srfi-37)
@@ -500,31 +501,19 @@ (define (order-packages lst)
   "Return LST, a list of top-level expressions and blanks, with
 top-level package definitions in alphabetical order.  Packages which
 share a name are placed with versions in descending order."
-  (define (package-name pkg)
+  (define (package-fields pkg)
     (match pkg
       ((('define-public _ expr) _ ...)
        (match expr
-         ((or ('package _ ('name name) _ ...)
-              ('package ('name name) _ ...))
-          name)
-         (_ #f)))
-      (_ #f)))
-
-  (define (package-version pkg)
-    (match pkg
-      ((('define-public _ expr) _ ...)
-       (match expr
-         ((or ('package _ _ ('version version) _ ...)
-              ('package _ ('version version) _ ...))
-          version)
-         (_ #f)))
-      (_ #f)))
+         ((or ('package _ ('name name) ('version version) _ ...)
+              ('package ('name name) ('version version) _ ...))
+          (values name version))
+         (_ (values #f #f))))
+      (_ (values #f #f))))
 
   (define (package>? lst1 lst2)
-    (let ((name1 (package-name lst1))
-          (name2 (package-name lst2))
-          (version1 (package-version lst1))
-          (version2 (package-version lst2)))
+    (let-values (((name1 version1) (package-fields lst1))
+                 ((name2 version2) (package-fields lst2)))
       (and name1 name2 (or (string>? name1 name2)
                            (and (string=? name1 name2)
                                 version1
@@ -550,7 +539,12 @@ (define* (format-whole-file file order? #:rest rest)
     (let* ((lst (call-with-input-file file read-with-comments/sequence
                                       #:guess-encoding #t))
            (lst (if order?
-                    (order-packages lst)
+                    (let loop ((lst lst))
+                      (match lst
+                        (((? blank? blank) rest ...)
+                         (cons blank (loop rest)))
+                        ((module rest ...)
+                         (cons module (order-packages rest)))))
                     lst)))
       (with-atomic-file-output file
         (lambda (port)
-- 
2.45.2

[bug#74979] [PATCH 2/4] scripts: style: Sort more kinds of package definitions.

[Herman Rimm via Guix-patches via]

* guix/scripts/style.scm (order-packages): Match comments before package
S-exp. and its fields.  Match in let.  Match package/inherit.

Change-Id: I48a5976930501c20415b5413966b5294958bc23b
---
 guix/scripts/style.scm | 13 +++++++------
 1 file changed, 7 insertions(+), 6 deletions(-)

diff --git a/guix/scripts/style.scm b/guix/scripts/style.scm
index 4b704ddfb7..6f07f6c3b9 100644
--- a/guix/scripts/style.scm
+++ b/guix/scripts/style.scm
@@ -503,13 +503,14 @@ (define (order-packages lst)
 share a name are placed with versions in descending order."
   (define (package-fields pkg)
     (match pkg
-      ((('define-public _ expr) _ ...)
+      ((('define-public pkg _ ... (or ('let _ expr) expr)) _ ...)
        (match expr
-         ((or ('package _ ('name name) ('version version) _ ...)
-              ('package ('name name) ('version version) _ ...))
-          (values name version))
-         (_ (values #f #f))))
-      (_ (values #f #f))))
+         (((or 'package 'package/inherit) fields ...)
+          (let ((name (and=> (assoc-ref fields 'name) first))
+                (version (and=> (assoc-ref fields 'version) first)))
+            (values name version)))
+         (_ (and (values #f #f)))))
+      (_ (and (values #f #f)))))
 
   (define (package>? lst1 lst2)
     (let-values (((name1 version1) (package-fields lst1))
-- 
2.45.2

[bug#74979] [PATCH 3/4] scripts: style: Only sort packages with string literal name.

[Herman Rimm via Guix-patches via]

* guix/scripts/style.scm (order-packages): Only match string literals.

Change-Id: I48a5976930501c20415b5413966b5294958bc23b
---
 guix/scripts/style.scm | 12 +++++++-----
 1 file changed, 7 insertions(+), 5 deletions(-)

diff --git a/guix/scripts/style.scm b/guix/scripts/style.scm
index 6f07f6c3b9..4801529f7e 100644
--- a/guix/scripts/style.scm
+++ b/guix/scripts/style.scm
@@ -515,11 +515,13 @@ (define (order-packages lst)
   (define (package>? lst1 lst2)
     (let-values (((name1 version1) (package-fields lst1))
                  ((name2 version2) (package-fields lst2)))
-      (and name1 name2 (or (string>? name1 name2)
-                           (and (string=? name1 name2)
-                                version1
-                                version2
-                                (version>? version2 version1))))))
+      (and (string? name1)
+           (string? name2)
+           (or (string>? name1 name2)
+               (and (string=? name1 name2)
+                    (string? version1)
+                    (string? version2)
+                    (version>? version2 version1))))))
 
         ;; Group define-public with preceding blanks and defines.
   (let ((lst (fold2 (lambda (expr tail head)
-- 
2.45.2

[bug#74979] [PATCH 4/4] scripts: style: Warn about unmatched package definitions.

[Herman Rimm via Guix-patches via]

* guix/scripts/style.scm (order-packages): Warn.

Change-Id: Iddbf979ee9ee5ed1ebada63776a390db024154fa
---
 guix/scripts/style.scm | 10 ++++++++--
 1 file changed, 8 insertions(+), 2 deletions(-)

diff --git a/guix/scripts/style.scm b/guix/scripts/style.scm
index 4801529f7e..81fe1141e2 100644
--- a/guix/scripts/style.scm
+++ b/guix/scripts/style.scm
@@ -508,9 +508,15 @@ (define (order-packages lst)
          (((or 'package 'package/inherit) fields ...)
           (let ((name (and=> (assoc-ref fields 'name) first))
                 (version (and=> (assoc-ref fields 'version) first)))
+            (if (and name version)
+                (unless (and (string? name) (string? version))
+                  (warning (G_ "non-string name/version for ~a~%") pkg))
+                (warning (G_ "package fields not found for ~a~%") pkg))
             (values name version)))
-         (_ (and (values #f #f)))))
-      (_ (and (values #f #f)))))
+         (_ (and (warning (G_ "package record missing for ~a~%") pkg)
+                 (values #f #f)))))
+      (_ (and (info (G_ "not sorting top-level S-exp.: ~a~%") pkg)
+              (values #f #f)))))
 
   (define (package>? lst1 lst2)
     (let-values (((name1 version1) (package-fields lst1))
-- 
2.45.2