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

[Herman Rimm via Guix-patches via <guix-patches@gnu.org>]

* 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