From c27f69ba49901fee7b6923bf07e45607fa07c587 Mon Sep 17 00:00:00 2001
From: Christopher Baines <mail@cbaines.net>
Date: Thu, 26 Dec 2019 15:10:22 +0000
Subject: guix: lint: Add an optional parameter for a store connection.

Previously, the derivation lint checker establishes a connection to the store
for each supported system of each package. This change uses the same store
connection for all supported systems, with the option of setting a parameter
for a store connection which will be used instead of establishing a new
connection.

Previously, running the derivation linter for all packages would take around 6
and a half minutes, with this change, without setting the
%lint-checker-store-connection parameter, the time is reduced to around 4
minutes.

* guix/lint.scm (%lint-checker-store-connection): New parameter.
(check-derivation): Arrange the code so that it's possible to either run with
the store from the new parameter, or open a new connection via the with-store
syntax.
---
 guix/lint.scm | 42 ++++++++++++++++++++++++++----------------
 1 file changed, 26 insertions(+), 16 deletions(-)

diff --git a/guix/lint.scm b/guix/lint.scm
index cd2ea571ed..19498db857 100644
--- a/guix/lint.scm
+++ b/guix/lint.scm
@@ -100,7 +100,9 @@
             lint-checker?
             lint-checker-name
             lint-checker-description
-            lint-checker-check))
+            lint-checker-check
+
+            %lint-checker-store-connection))
 
 
 ;;;
@@ -142,6 +144,9 @@
     ((_ package (G_ message) rest ...)
      (%make-warning package message rest ...))))
 
+(define %lint-checker-store-connection
+  (make-parameter #f))
+
 
 ;;;
 ;;; Checkers
@@ -887,7 +892,7 @@ descriptions maintained upstream."
 
 (define (check-derivation package)
   "Emit a warning if we fail to compile PACKAGE to a derivation."
-  (define (try system)
+  (define (try store system)
     (catch #t
       (lambda ()
         (guard (c ((store-protocol-error? c)
@@ -900,25 +905,30 @@ descriptions maintained upstream."
                                  (G_ "failed to create ~a derivation: ~a")
                                  (list system
                                        (condition-message c)))))
-          (with-store store
-            ;; Disable grafts since it can entail rebuilds.
-            (parameterize ((%graft? #f))
-              (package-derivation store package system #:graft? #f)
-
-              ;; If there's a replacement, make sure we can compute its
-              ;; derivation.
-              (match (package-replacement package)
-                (#f #t)
-                (replacement
-                 (package-derivation store replacement system
-                                     #:graft? #f)))))))
+          ;; Disable grafts since it can entail rebuilds.
+          (parameterize ((%graft? #f))
+            (package-derivation store package system #:graft? #f)
+
+            ;; If there's a replacement, make sure we can compute its
+            ;; derivation.
+            (match (package-replacement package)
+              (#f #t)
+              (replacement
+               (package-derivation store replacement system
+                                   #:graft? #f))))))
       (lambda args
         (make-warning package
                       (G_ "failed to create ~a derivation: ~s")
                       (list system args)))))
 
-  (filter lint-warning?
-          (map try (package-supported-systems package))))
+  (define (check-with-store store)
+    (filter lint-warning?
+            (map (cut try store <>) (package-supported-systems package))))
+
+  (or (and=> (%lint-checker-store-connection)
+             check-with-store)
+      (with-store store
+        (check-with-store store))))
 
 (define (check-license package)
   "Warn about type errors of the 'license' field of PACKAGE."
-- 
cgit v1.2.3