scripts: lint: Add 'whole-file' option with ordering lint.issue-70499

* 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

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 @@ guix lint @var{options} @var{package}@dots{}
 @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 @@ Only enable the checkers that do not depend on Internet access.
 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 @@ run the checkers on all packages.\n"))
   -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 @@ run the checkers on all packages.\n"))
                 (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 @@ run the checkers on all packages.\n"))
                         #: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 @@ run the checkers on all packages.\n"))
         (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)) '()))