[bug#70499] [PATCH] utils: Add find-unordered-packages procedure.

[bug#70499] [PATCH] utils: Add find-unordered-packages procedure.

[Herman Rimm via Guix-patches via]

* guix/utils.scm (find-unordered-packages): Add and export procedure.
* tests/utils.scm ("find-unordered-packages"): Add test.

Change-Id: I26ea0fca7d428b192711f75ff3cf5e5a4416b1b6
---
Hello,

I added a procedure which returns the line numbers where packages break
from alphabetical order, e.g.:

  scheme@(guix-user)> (lset-xor eqv? (find-unordered-packages
  "gnu/packages/crates-io.scm"))
  $1 = (626 1153 2693 2715 2840 4074 4139 4187 6099 6243 6382 6896 7677
  9465 10346 11424 12089 12552 12676 12887 16147 16364 16897 18195 18260
  19912 21335 22489 22792 23898 24344 24801 25443 25492 26591 27832
  27944 31206 32365 32502 32609 32770 34281 34913 36192 36320 36621
  36718 36828 37511 38169 39000 39360 39684 40921 41153 41459 41501
  42121 42803 42910 44318 44585 46435 47350 47456 47709 48043 49624
  49905 51084 51216 51560 53586 54473 57062 58925 59048 59134 59584
  59664 59702 59914 62399 66006 66266 66391 68003 68200 68244 70292
  70321 71660 71686 71761 72643 73746 73880 74434 74459 77309 77646
  78136 79569 81722 81896 83802 85617 87167 89037 92212)

It could be extended to also expect package versions in decreasing
order. Maybe I can use it to sort packages automatically later. 

Cheers,
Herman
 guix/utils.scm  | 21 +++++++++++++++++++++
 tests/utils.scm | 19 +++++++++++++++++++
 2 files changed, 40 insertions(+)

diff --git a/guix/utils.scm b/guix/utils.scm
index d8ce6ed886..f690618306 100644
--- a/guix/utils.scm
+++ b/guix/utils.scm
@@ -148,6 +148,7 @@ (define-module (guix utils)
             delete-expression
             insert-expression
             find-definition-insertion-location
+            find-unordered-packages
 
             filtered-port
             decompressed-port
@@ -531,6 +532,26 @@ (define (find-definition-insertion-location file term)
            (and (not (eof-object? syntax))
                 (syntax-source syntax))))))))
 
+(define (find-unordered-packages file)
+  "Return the line numbers of top-level package definitions whose name
+alphabetically preceeds the previous name."
+  (call-with-input-file file
+    (lambda (port)
+      (let loop ((lst '())
+                 (previous-name ""))
+        (match (read-syntax port)
+          ((? eof-object?)
+           (reverse! lst))
+          (exp
+            (match (syntax->datum exp)
+              (('define-public _ (or ('package _ ('name name) _ ...)
+                                     ('package ('name name) _ ...)))
+               (loop (if (string< name previous-name)
+                         (cons (assoc-ref (syntax-source exp) 'line) lst)
+                         lst)
+                     name))
+              (_ (loop lst previous-name)))))))))
+
 \f
 ;;;
 ;;; Keyword arguments.
diff --git a/tests/utils.scm b/tests/utils.scm
index 462e43e2b1..8956ea5420 100644
--- a/tests/utils.scm
+++ b/tests/utils.scm
@@ -303,6 +303,25 @@ (define-public package-2\n  'package)\n"
            (find-definition-insertion-location temp-file term))
          (list 'package 'package-1 'package-2))))
 
+(test-equal "find-unordered-packages"
+  (list 7)
+  (begin
+    (call-with-output-file temp-file
+      (lambda (port)
+        (display "
+(define-public rust-addr2line-0.19
+  (package
+    (inherit rust-addr2line-0.21)
+    (name \"rust-addr2line\")
+    (version \"0.19.0\")))
+
+(define-public rust-addchain-0.2
+  (package
+    (name \"rust-addchain\")
+    (version \"0.2.0\")))
+" port)))
+    (find-unordered-packages temp-file)))
+
 (test-equal "string-distance"
   '(0 1 1 5 5)
   (list

base-commit: a1d711c92e119f6b5b8e99a620cdba92a4ca3bfb
-- 
2.41.0

[bug#70499] [PATCH] utils: Add find-unordered-packages procedure.

[Ludovic Courtès]

Hi Herman,

Herman Rimm <herman@rimm.ee> skribis:

> * guix/utils.scm (find-unordered-packages): Add and export procedure.
> * tests/utils.scm ("find-unordered-packages"): Add test.
>
> Change-Id: I26ea0fca7d428b192711f75ff3cf5e5a4416b1b6
> ---
> Hello,
>
> I added a procedure which returns the line numbers where packages break
> from alphabetical order, e.g.:
>
>   scheme@(guix-user)> (lset-xor eqv? (find-unordered-packages
>   "gnu/packages/crates-io.scm"))
>   $1 = (626 1153 2693 2715 2840 4074 4139 4187 6099 6243 6382 6896 7677
>   9465 10346 11424 12089 12552 12676 12887 16147 16364 16897 18195 18260
>   19912 21335 22489 22792 23898 24344 24801 25443 25492 26591 27832
>   27944 31206 32365 32502 32609 32770 34281 34913 36192 36320 36621
>   36718 36828 37511 38169 39000 39360 39684 40921 41153 41459 41501
>   42121 42803 42910 44318 44585 46435 47350 47456 47709 48043 49624
>   49905 51084 51216 51560 53586 54473 57062 58925 59048 59134 59584
>   59664 59702 59914 62399 66006 66266 66391 68003 68200 68244 70292
>   70321 71660 71686 71761 72643 73746 73880 74434 74459 77309 77646
>   78136 79569 81722 81896 83802 85617 87167 89037 92212)
>
> It could be extended to also expect package versions in decreasing
> order. Maybe I can use it to sort packages automatically later. 

Nice.  Do you plan to use this procedure in a command-line tool?

> +(define (find-unordered-packages file)
> +  "Return the line numbers of top-level package definitions whose name
> +alphabetically preceeds the previous name."

My first thought when seeing the name is that this was returning a list
of packages, and then I wondered how it differed from ‘fold-packages’
and the likes.

Maybe call it ‘package-definition-alphabetical-sort-breakage’ or
something like that?

Thanks,
Ludo’.

[bug#70499] [PATCH v2 0/3] Lint package order.

[Herman Rimm via Guix-patches via]

Hi,

I do not think 'find-unordered-packages' would be useful for e.g. guix
style, so I made a similar procedure in (guix scripts lint) instead.  It
is implemented with 'fold-packages' to get package records to pass to
the 'run-checkers' procedure.  So now you can use guix lint with
--whole-file to also lint the package ordering, for example:

  $ guix lint -f gnu/packages/matrix.scm -n
  gnu/packages/matrix.scm:161:0: python-matrix-nio@0.20.2: breaks from alphabetical order
  gnu/packages/matrix.scm:244:0: pantalaimon@0.10.5: breaks from alphabetical order

However the alphabetical order lint warnings only appear once another
type of lint warning is emitted, or when end of file is reached and
linting finishes. So if few checkers are enabled, it takes a few seconds
before anything is output for large module files, like 'crates-io.scm'.
Can this be fixed easily?

Cheers,
Herman

Herman Rimm (3):
  guix: Move ‘package-location<?’ to (guix packages).
  ui: Make 'user-module' parameter of 'load*' optional.
  scripts: lint: Add 'whole-file' option with ordering lint.

 doc/guix.texi          | 23 ++++++++++++++++--
 guix/packages.scm      | 11 +++++++++
 guix/scripts/lint.scm  | 55 +++++++++++++++++++++++++++++++++++++-----
 guix/scripts/style.scm |  9 -------
 guix/ui.scm            |  3 ++-
 5 files changed, 83 insertions(+), 18 deletions(-)


base-commit: ef8ab6ab66c4d629699d175938ef1912941d4dce
-- 
2.41.0

[bug#70499] [PATCH v2 1/3] guix: Move ‘package-location<?’ to (guix packages).

[Herman Rimm via Guix-patches via]

* guix/scripts/style.scm (package-location<?): Move to…
* guix/packages.scm (package-location<?): … here.

Change-Id: I8ebb37c261a1bb3fa5772177b27fd62a2553e318
---
 guix/packages.scm      | 11 +++++++++++
 guix/scripts/style.scm |  9 ---------
 2 files changed, 11 insertions(+), 9 deletions(-)

diff --git a/guix/packages.scm b/guix/packages.scm
index 4385e4f930..d878cc071e 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -116,6 +116,8 @@ (define-module (guix packages)
             deprecated-package
             package-field-location
 
+            package-location<?
+
             this-package-input
             this-package-native-input
 
@@ -815,6 +817,15 @@ (define (package-field-location package field)
         #f)))
     (_ #f)))
 
+(define (package-location<? p1 p2)
+  "Return true if P1's location is \"before\" P2's."
+  (let ((loc1 (package-location p1))
+        (loc2 (package-location p2)))
+    (and loc1 loc2
+         (if (string=? (location-file loc1) (location-file loc2))
+             (< (location-line loc1) (location-line loc2))
+             (string<? (location-file loc1) (location-file loc2))))))
+
 (define-syntax-rule (this-package-input name)
   "Return the input NAME of the package being defined--i.e., an input
 from the ‘inputs’ or ‘propagated-inputs’ field.  Native inputs are not
diff --git a/guix/scripts/style.scm b/guix/scripts/style.scm
index 211980dc1c..534034b271 100644
--- a/guix/scripts/style.scm
+++ b/guix/scripts/style.scm
@@ -480,15 +480,6 @@ (define* (format-package-definition package
                         #:format-comment canonicalize-comment
                         #:format-vertical-space canonicalize-vertical-space)))))
 
-(define (package-location<? p1 p2)
-  "Return true if P1's location is \"before\" P2's."
-  (let ((loc1 (package-location p1))
-        (loc2 (package-location p2)))
-    (and loc1 loc2
-         (if (string=? (location-file loc1) (location-file loc2))
-             (< (location-line loc1) (location-line loc2))
-             (string<? (location-file loc1) (location-file loc2))))))
-
 \f
 ;;;
 ;;; Whole-file formatting.
-- 
2.41.0

[bug#70499] [PATCH v2 2/3] ui: Make 'user-module' parameter of 'load*' optional.

[Herman Rimm via Guix-patches via]

* guix/ui.scm (load*): Make 'user-module' paramater optional.

Change-Id: I4ebf854cd48bb8944bd70ac1c3ece4476fd6710c
---
 guix/ui.scm | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/guix/ui.scm b/guix/ui.scm
index d82fa533cc..8839079ee0 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -216,7 +216,8 @@ (define (try-canonicalize-path file)
       (canonicalize-path file))
     (const file)))
 
-(define* (load* file user-module
+(define* (load* file #:optional
+                (user-module (make-fresh-user-module))
                 #:key (on-error 'nothing-special))
   "Load the user provided Scheme source code FILE."
   (define (error-string frame args)
-- 
2.41.0

[bug#70499] [PATCH v2 3/3] scripts: lint: Add 'whole-file' option with ordering lint.

[Herman Rimm via Guix-patches via]

* guix/scripts/lint.scm (show-help): Describe option.
(%options): Add 'whole-file' option.
(guix-lint): Lint (order of) packages in files.
* doc/guix.texi (Invoking guix lint): Document option.

Change-Id: I52b48a9a6982d0c4a03416e3d070887c64716485
---
 doc/guix.texi         | 23 ++++++++++++++++--
 guix/scripts/lint.scm | 55 ++++++++++++++++++++++++++++++++++++++-----
 2 files changed, 70 insertions(+), 8 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 1c1e0164e7..c68b62d475 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -15349,6 +15349,12 @@ Invoking guix lint
 @end example
 
 If no package is given on the command line, then all packages are checked.
+To lint entire source files, the syntax is:
+
+@example
+guix lint @var{options} --whole-file @var{file}@dots{}
+@end example
+
 The @var{options} may be zero or more of the following:
 
 @table @code
@@ -15386,9 +15392,22 @@ Invoking guix lint
 Add @var{directory} to the front of the package module search path
 (@pxref{Package Modules}).
 
-This allows users to define their own packages and make them visible to
-the command-line tools.
+@item --whole-file
+@itemx -f
+Lint the given files in their entirety.  In that case, subsequent
+arguments are interpreted as file names (rather than package names).
+Also, an additional checker is enabled, which checks if a package
+alphabetically succeeds the one above it.
+
+As an example, here is how you might quickly check if packages are in
+alphabetical order:
+
+@example
+guix lint -c name -f gnu/packages/matrix.scm
+@end example
 
+The previous two options allow users to define their own packages and
+make them visible to the command-line tools.
 @end table
 
 @node Invoking guix size
diff --git a/guix/scripts/lint.scm b/guix/scripts/lint.scm
index ee3de51fb1..86ff5cf1c0 100644
--- a/guix/scripts/lint.scm
+++ b/guix/scripts/lint.scm
@@ -11,6 +11,7 @@
 ;;; Copyright © 2018, 2019 Arun Isaac <arunisaac@systemreboot.net>
 ;;; Copyright © 2019, 2020 Simon Tournier <zimon.toutoune@gmail.com>
 ;;; Copyright © 2020 Brice Waegeneire <brice@waegenei.re>
+;;; Copyright © 2024 Herman Rimm <herman@rimm.ee>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -28,8 +29,10 @@
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (guix scripts lint)
+  #:use-module (guix diagnostics)
   #:use-module (guix packages)
   #:use-module (guix lint)
+  #:use-module (guix modules)
   #:use-module (guix ui)
   #:use-module (guix store)
   #:use-module (guix scripts)
@@ -115,6 +118,9 @@ (define (show-help)
   -L, --load-path=DIR    prepend DIR to the package module search path"))
   (newline)
   (display (G_ "
+  -f, --whole-file       lint the entire contents of the given file(s)"))
+  (newline)
+  (display (G_ "
   -h, --help             display this help and exit"))
   (display (G_ "
   -l, --list-checkers    display the list of available lint checkers"))
@@ -161,6 +167,9 @@ (define %options
                 (lambda args
                   (leave-on-EPIPE (show-help))
                   (exit 0)))
+        (option '(#\f "whole-file") #f #f
+                (lambda (opt name arg result)
+                  (alist-cons 'whole-file? #t result)))
         (option '(#\l "list-checkers") #f #f
                 (lambda (opt name arg result)
                   (alist-cons 'list? #t result)))
@@ -187,12 +196,17 @@ (define-command (guix-lint . args)
                         #:build-options? #f))
 
   (let* ((opts (parse-options))
-         (args (filter-map (match-lambda
-                             (('argument . spec)
-                              (specification->package spec))
-                             (('expression . exp)
-                              (read/eval-package-expression exp))
-                             (_ #f))
+         (whole-file? (assoc-ref opts 'whole-file?))
+         (args (filter-map (if whole-file?
+                               (match-lambda
+                                 (('argument . file) file)
+                                 (_ #f))
+                               (match-lambda
+                                 (('argument . spec)
+                                  (specification->package spec))
+                                 (('expression . exp)
+                                  (read/eval-package-expression exp))
+                                 (_ #f)))
                            (reverse opts)))
          (no-checkers (or (assoc-ref opts 'exclude) '()))
          (the-checkers (filter (lambda (checker)
@@ -221,6 +235,35 @@ (define-command (guix-lint . args)
         (call-maybe-with-store
          (lambda (store)
            (cond
+            (whole-file?
+             (when (null? args)
+               (warning (G_ "no files specified, nothing to do~%")))
+             (for-each
+               (lambda (file)
+                 (load* file)
+                 (let* ((module (resolve-interface
+                                  (file-name->module-name file)))
+                        (packages (sort (fold-packages cons '()
+                                                       (list module))
+                                        package-location<?)))
+                   (fold (lambda (package previous)
+                           (let ((line (location-line
+                                         (package-location package)))
+                                 (text "breaks from alphabetical order")
+                                 (name (package-name package)))
+                             (run-checkers package checkers
+                                           #:store store)
+                             (and (string< name previous)
+                                  (emit-warnings
+                                    (list (lint-warning
+                                            (package package)
+                                            (location
+                                              (location file line 0))
+                                            (message-text (G_ text))
+                                            (message-data '())))))
+                             name))
+                         "" packages)))
+               args))
             ((null? args)
              (fold-packages (lambda (p r) (run-checkers p checkers
                                                         #:store store)) '()))
-- 
2.41.0

[bug#70499] [PATCH v2 0/3] Lint package order.

[Ludovic Courtès]

Hi Herman,

Herman Rimm <herman@rimm.ee> skribis:

> I do not think 'find-unordered-packages' would be useful for e.g. guix
> style, so I made a similar procedure in (guix scripts lint) instead.  It
> is implemented with 'fold-packages' to get package records to pass to
> the 'run-checkers' procedure.  So now you can use guix lint with
> --whole-file to also lint the package ordering, for example:

Nice.

>   $ guix lint -f gnu/packages/matrix.scm -n
>   gnu/packages/matrix.scm:161:0: python-matrix-nio@0.20.2: breaks from alphabetical order
>   gnu/packages/matrix.scm:244:0: pantalaimon@0.10.5: breaks from alphabetical order
>
> However the alphabetical order lint warnings only appear once another
> type of lint warning is emitted, or when end of file is reached and
> linting finishes. So if few checkers are enabled, it takes a few seconds
> before anything is output for large module files, like 'crates-io.scm'.
> Can this be fixed easily?

I’m not sure I understand.  The alpabetical checker is part of another
patch set, right?  (I know I’ve seen it, but I’m afraid I’ve lost track
of it. :-))

Anyway, we can and should discuss ‘--whole-file’ independently of the
alphabetical-order checker.

>   guix: Move ‘package-location<?’ to (guix packages).
>   ui: Make 'user-module' parameter of 'load*' optional.
>   scripts: lint: Add 'whole-file' option with ordering lint.

This LGTM modulo minor issues:

  • The second patch looks unrelated to ‘--whole-file’, I’d drop it from
    this series.

  • The third patch misses just one thing: a test in
    ‘tests/guix-lint.sh’.

Could you send an updated patch series?

Thanks, and apologies for the delay!

Ludo’.