summaryrefslogtreecommitdiff
path: root/guix
diff options
context:
space:
mode:
authorChristopher Baines <mail@cbaines.net>2020-03-15 20:53:02 +0000
committerChristopher Baines <mail@cbaines.net>2020-03-24 19:47:46 +0000
commit7826fbc02b19727e4bd56dd3a4dc3046f2770b84 (patch)
tree7f0f1eb55ce5b0afa4b2af63f74c324d4d17dfc5 /guix
parentd84ad6a24ed0a51f72db0a17df093e79cd600f6d (diff)
lint: Add a #:store argument to check-derivation
This can then be used to avoid opening up a store connection each time a package needs checking. * guix/lint.scm (check-derivation): Add a #:store argument, and pull the handling of the store connection out of the try function.
Diffstat (limited to 'guix')
-rw-r--r--guix/lint.scm36
1 files changed, 20 insertions, 16 deletions
diff --git a/guix/lint.scm b/guix/lint.scm
index 631ba3b59d..2be3cc3ee3 100644
--- a/guix/lint.scm
+++ b/guix/lint.scm
@@ -918,9 +918,9 @@ descriptions maintained upstream."
(define exception-with-kind-and-args?
(const #f))))
-(define (check-derivation package)
+(define* (check-derivation package #:key store)
"Emit a warning if we fail to compile PACKAGE to a derivation."
- (define (try system)
+ (define (try store system)
(catch #t ;TODO: Remove 'catch' when Guile 2.x is no longer supported.
(lambda ()
(guard (c ((store-protocol-error? c)
@@ -939,25 +939,29 @@ 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)))))))
+ (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))))
+
+ ;; For backwards compatability, don't rely on store being set
+ (or (and=> store check-with-store)
+ (with-store store
+ (check-with-store store))))
(define (check-license package)
"Warn about type errors of the 'license' field of PACKAGE."