diff mbox series

[bug#38754,4/4] scripts: lint: Handle store connections for lint checkers.

Message ID 20200315210631.5334-4-mail@cbaines.net
State Accepted
Headers show
Series [bug#38754,1/4] lint: Add a requires-store? field to the checker record. | expand

Checks

Context Check Description
cbaines/comparison success View comparision
cbaines/git branch success View Git branch
cbaines/applying patch success View Laminar job
cbaines/comparison success View comparision
cbaines/git branch success View Git branch
cbaines/applying patch success View Laminar job

Commit Message

Christopher Baines March 15, 2020, 9:06 p.m. UTC 
Rather than individual checkers opening up a connection to the store for each
package to check, if any checker requires a store connection, open a
connection and pass it to all checkers that would use it. This makes running
the derivation checker much faster for multiple packages.

* guix/scripts/lint.scm (run-checkers): Add a #:store argument, and pass the
store to checkers if they require a store connection.
(guix-lint): Establish a store connection if any checker requires one, and
pass it through to run-checkers.
---
 guix/scripts/lint.scm | 38 ++++++++++++++++++++++++++++----------
 1 file changed, 28 insertions(+), 10 deletions(-)
diff mbox series

Patch

diff --git a/guix/scripts/lint.scm b/guix/scripts/lint.scm
index 8d08c484f5..97ffd57301 100644
--- a/guix/scripts/lint.scm
+++ b/guix/scripts/lint.scm
@@ -30,6 +30,7 @@ 
   #:use-module (guix packages)
   #:use-module (guix lint)
   #:use-module (guix ui)
+  #:use-module (guix store)
   #:use-module (guix scripts)
   #:use-module (guix scripts build)
   #:use-module (gnu packages)
@@ -53,7 +54,7 @@ 
              (lint-warning-message lint-warning))))
    warnings))
 
-(define (run-checkers package checkers)
+(define* (run-checkers package checkers #:key store)
   "Run the given CHECKERS on PACKAGE."
   (let ((tty? (isatty? (current-error-port))))
     (for-each (lambda (checker)
@@ -63,7 +64,9 @@ 
                           (lint-checker-name checker))
                   (force-output (current-error-port)))
                 (emit-warnings
-                 ((lint-checker-check checker) package)))
+                 (if (lint-checker-requires-store? checker)
+                     ((lint-checker-check checker) package #:store store)
+                     ((lint-checker-check checker) package))))
               checkers)
     (when tty?
       (format (current-error-port) "\x1b[K")
@@ -167,12 +170,27 @@  run the checkers on all packages.\n"))
                              (_ #f))
                            (reverse opts)))
          (checkers (or (assoc-ref opts 'checkers) %all-checkers)))
-    (cond
-     ((assoc-ref opts 'list?)
+
+    (when (assoc-ref opts 'list?)
       (list-checkers-and-exit checkers))
-     ((null? args)
-      (fold-packages (lambda (p r) (run-checkers p checkers)) '()))
-     (else
-      (for-each (lambda (spec)
-                  (run-checkers (specification->package spec) checkers))
-                args)))))
+
+    (let ((any-lint-checker-requires-store?
+           (any lint-checker-requires-store? checkers)))
+
+      (define (call-maybe-with-store proc)
+        (if any-lint-checker-requires-store?
+            (with-store store
+              (proc store))
+            (proc #f)))
+
+      (call-maybe-with-store
+       (lambda (store)
+         (cond
+          ((null? args)
+           (fold-packages (lambda (p r) (run-checkers p checkers
+                                                      #:store store)) '()))
+          (else
+           (for-each (lambda (spec)
+                       (run-checkers (specification->package spec) checkers
+                                     #:store store))
+                     args))))))))