[bug#71697] [PATCH v3 2/2] scripts: lint: Honor package property to exclude checkers.

[Simon Tournier <zimon.toutoune@gmail.com>]

* guix/scripts/lint.scm (exclude-package-checkers): New procedure, filter the
checker if the package is marked.
(guix-lint)[show-package-checkers]: New procedure.
* doc/guix.texi: Document it.

Change-Id: Idf8e5c67102a1701ebd917bbc6212cfeb6ea2054
---
 doc/guix.texi         | 17 ++++++++++++++++-
 guix/scripts/lint.scm | 26 +++++++++++++++++++++++++-
 2 files changed, 41 insertions(+), 2 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 037b1a2f24..1baf3fafe6 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -71,7 +71,7 @@
 Copyright @copyright{} 2019 Alex Griffin@*
 Copyright @copyright{} 2019, 2020, 2021, 2022 Guillaume Le Vaillant@*
 Copyright @copyright{} 2020 Liliana Marie Prikler@*
-Copyright @copyright{} 2019, 2020, 2021, 2022, 2023 Simon Tournier@*
+Copyright @copyright{} 2019, 2020, 2021, 2022, 2023, 2024 Simon Tournier@*
 Copyright @copyright{} 2020 Wiktor Żelazny@*
 Copyright @copyright{} 2020 Damien Cassou@*
 Copyright @copyright{} 2020 Jakub Kądziołka@*
@@ -15444,6 +15444,21 @@ Invoking guix lint
 to the new style.
 @end table
 
+Sometimes it is not desired to run the same checker each time
+@command{guix lint} is invoked---e.g., because the checker takes time or
+to avoid to send again and again the same request for archiving.
+Instead of excluding the checker at the command-line via the option
+@code{--exclude}, the package might be marked to skip the checker by
+honoring the property in package definition, e.g.,
+
+@lisp
+(package
+  (name "python-scikit-learn")
+  ;; @dots{}
+  (properties '((lint-exclude-archival? . #t)
+                (lint-exclude-home-page? . #t))))
+@end lisp
+
 The general syntax is:
 
 @example
diff --git a/guix/scripts/lint.scm b/guix/scripts/lint.scm
index b98266c831..7aed467eae 100644
--- a/guix/scripts/lint.scm
+++ b/guix/scripts/lint.scm
@@ -9,7 +9,7 @@
 ;;; Copyright © 2017 Tobias Geerinckx-Rice <me@tobias.gr>
 ;;; Copyright © 2017, 2018 Efraim Flashner <efraim@flashner.co.il>
 ;;; Copyright © 2018, 2019 Arun Isaac <arunisaac@systemreboot.net>
-;;; Copyright © 2019, 2020 Simon Tournier <zimon.toutoune@gmail.com>
+;;; Copyright © 2019, 2020, 2024 Simon Tournier <zimon.toutoune@gmail.com>
 ;;; Copyright © 2020 Brice Waegeneire <brice@waegenei.re>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -39,6 +39,7 @@ (define-module (guix scripts lint)
   #:use-module (ice-9 format)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-37)
+  #:use-module (srfi srfi-26)
   #:export (guix-lint
             run-checkers))
 
@@ -59,6 +60,18 @@ (define (emit-warnings warnings)
                name version message))))
    warnings))
 
+(define (exclude-package-checkers package checkers)
+  "Filter the CHECKERS list using PACKAGE properties field."
+  (let ((properties (package-properties package)))
+    (filter (lambda (checker)
+              (not (assq-ref properties
+                             ((compose string->symbol
+                                       (cut string-append "lint-exclude-" <> "?")
+                                       symbol->string
+                                       lint-checker-name)
+                              checker))))
+            checkers)))
+
 (define* (run-checkers package checkers #:key store)
   "Run the given CHECKERS on PACKAGE."
   (let ((tty? (isatty? (current-error-port))))
@@ -223,16 +236,27 @@ (define-command (guix-lint . args)
                 (proc store))
               (proc #f)))
 
+        (define (show-package-checkers package checkers)
+          (format (current-error-port) "~a@~a checked by~{ ~a~}.~%"
+                  (package-name package)
+                  (package-version package)
+                  (sort (map (compose symbol->string lint-checker-name)
+                             (exclude-package-checkers
+                              package checkers))
+                   string<?)))
+
         (call-maybe-with-store
          (lambda (store)
            (cond
             ((null? args)
              (fold-packages (lambda (p r)
+                              (show-package-checkers p checkers)
                               (when (not (assoc-ref opts 'dry-run?))
                                 (run-checkers p checkers
                                               #:store store))) '()))
             (else
              (for-each (lambda (package)
+                         (show-package-checkers package checkers)
                          (when (not (assoc-ref opts 'dry-run?))
                              (run-checkers package checkers
                                            #:store store)))
-- 
2.41.0