[bug#70800] [PATCH] scripts: style: Add 'order' option to alphabetically order file.

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

* guix/scripts/style.scm (show-help): Describe option.
(order-packages): Add procedure.
(format-whole-file): Add 'order?' argument.
(%options): Add 'order' option.
(guix-style): Alphabetically order packages in files.
* doc/guix.texi (Invoking guix style): Document option.

Change-Id: I4aa7c0bd0b6d42529ae7d304587ffb10bf5f4006
---
Hi,

I managed to create a procedure which alphabetically sorts top-level
package definitions.  Sort is not stable as I understand it, so versions
of packages get swapped.  It works well enough in small package modules,
and should not be a problem once package versions are used in sorting.

Cheers,
Herman

 doc/guix.texi          |  6 +++++
 guix/scripts/style.scm | 52 +++++++++++++++++++++++++++++++++++++-----
 2 files changed, 52 insertions(+), 6 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 1c1e0164e7..6316f6bfc9 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -15097,6 +15097,12 @@ Invoking guix style
 guix style -f /etc/config.scm
 @end example
 
+@item --order
+@itemx -o
+Place the top-level package definitions in the given files in alphabetical
+order.  This option only has an effect in combination with
+@option{--whole-file}.
+
 @item --styling=@var{rule}
 @itemx -S @var{rule}
 Apply @var{rule}, one of the following styling rules:
diff --git a/guix/scripts/style.scm b/guix/scripts/style.scm
index 211980dc1c..ace28c1bca 100644
--- a/guix/scripts/style.scm
+++ b/guix/scripts/style.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2021-2023 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2024 Herman Rimm <herman@rimm.ee>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -29,6 +30,7 @@
 
 (define-module (guix scripts style)
   #:autoload   (gnu packages) (specification->package fold-packages)
+  #:use-module (guix combinators)
   #:use-module (guix scripts)
   #:use-module ((guix scripts build) #:select (%standard-build-options))
   #:use-module (guix ui)
@@ -494,11 +496,43 @@ (define (package-location<? p1 p2)
 ;;; Whole-file formatting.
 ;;;
 
-(define* (format-whole-file file #:rest rest)
-  "Reformat all of FILE."
+(define (order-packages lst)
+  "Place top-level package definitions in LST in alphabetical order."
+         ;; Group define-public with preceding blanks and defines.
+  (let* ((lst (identity
+                (fold2 (lambda (expr tail head)
+                         (let ((head (cons expr head)))
+                           (match expr
+                             ((? blank?)
+                              (values tail head))
+                             (('define _ ...)
+                              (values tail head))
+                             (_ (values (cons head tail) '())))))
+                       '() '() lst)))
+         (package-name (lambda (pkg)
+                         (match pkg
+                           ((('define-public _ expr) _ ...)
+                            (match expr
+                              ((or ('package _ ('name name) _ ...)
+                                   ('package ('name name) _ ...))
+                               name)
+                              (_ #f)))
+                           (_ #f))))
+         (lst (sort lst (lambda (lst1 lst2)
+                          (let ((name1 (package-name lst1))
+                                (name2 (package-name lst2)))
+                            (and name1 name2 (string> name1 name2)))))))
+    (reverse (concatenate lst))))
+
+(define* (format-whole-file file order? #:rest rest)
+  "Reformat all of FILE. When ORDER? is true, top-level package definitions
+  are put in alphabetical order."
   (with-fluids ((%default-port-encoding "UTF-8"))
-    (let ((lst (call-with-input-file file read-with-comments/sequence
-                                     #:guess-encoding #t)))
+    (let* ((lst (call-with-input-file file read-with-comments/sequence
+                                     #:guess-encoding #t))
+           (lst (if order?
+                    (order-packages lst)
+                    lst)))
       (with-atomic-file-output file
         (lambda (port)
           (apply pretty-print-with-comments/splice port lst
@@ -526,6 +560,9 @@ (define %options
         (option '(#\f "whole-file") #f #f
                 (lambda (opt name arg result)
                   (alist-cons 'whole-file? #t result)))
+        (option '(#\o "order") #f #f
+                (lambda (opt name arg result)
+                  (alist-cons 'order? #t result)))
         (option '(#\S "styling") #t #f
                 (lambda (opt name arg result)
                   (alist-cons 'styling-procedure
@@ -569,7 +606,7 @@ (define (show-help)
   (display (G_ "
   -S, --styling=RULE     apply RULE, a styling rule"))
   (display (G_ "
-  -l, --list-stylings   display the list of available style rules"))
+  -l, --list-stylings    display the list of available style rules"))
   (newline)
   (display (G_ "
   -n, --dry-run          display files that would be edited but do nothing"))
@@ -584,6 +621,8 @@ (define (show-help)
   (newline)
   (display (G_ "
   -f, --whole-file       format the entire contents of the given file(s)"))
+  (display (G_ "
+  -o, --order            place the contents in alphabetical order as well"))
   (newline)
   (display (G_ "
   -h, --help             display this help and exit"))
@@ -627,7 +666,8 @@ (define-command (guix-style . args)
               (warning (G_ "'--styling' option has no effect in whole-file mode~%")))
             (when (null? files)
               (warning (G_ "no files specified, nothing to do~%")))
-            (for-each format-whole-file files))
+            (for-each format-whole-file
+                      files (map (const (assoc-ref opts 'order?)) files)))
           (let ((packages (filter-map (match-lambda
                                         (('argument . spec)
                                          (specification->package spec))

base-commit: ef8ab6ab66c4d629699d175938ef1912941d4dce
-- 
2.41.0