civodul pushed a commit to branch wip-guix-index
in repository guix.
commit df59924abb90d565aff818fc7ee5d697bd87aa37
Author: Ludovic Courtès <[email protected]>
AuthorDate: Sun Jun 4 22:26:20 2023 +0200
squash! Optimize 'insert-package'.
That makes 'guix locate -m store -u' slightly faster by not computing
the derivation of an already-indexed package.
---
guix/scripts/locate.scm | 49 ++++++++++++++++++++++++++++++++++---------------
1 file changed, 34 insertions(+), 15 deletions(-)
diff --git a/guix/scripts/locate.scm b/guix/scripts/locate.scm
index a8a8f96be5..bc30b5269f 100644
--- a/guix/scripts/locate.scm
+++ b/guix/scripts/locate.scm
@@ -217,13 +217,12 @@ VALUES (:name, :basename, :directory);"
(sqlite-exec db "begin immediate;")
;; 1 record per output
(for-each (lambda (output)
- (let ((out (if (string=? "out" output) "" output)))
- (sqlite-reset stmt-insert-package)
- (sqlite-bind-arguments stmt-insert-package
- #:name package
- #:version version
- #:output out)
- (sqlite-fold (const #t) #t stmt-insert-package)))
+ (sqlite-reset stmt-insert-package)
+ (sqlite-bind-arguments stmt-insert-package
+ #:name package
+ #:version version
+ #:output output)
+ (sqlite-fold (const #t) #t stmt-insert-package))
outputs)
(sqlite-bind-arguments stmt-select-package
#:name package
@@ -274,14 +273,34 @@ VALUES (:name, :basename, :directory);"
(define (insert-package db package)
"Insert all the files of PACKAGE into DB."
- (mlet %store-monad ((drv (package->derivation package #:graft? #f)))
- (match (derivation->output-paths drv)
- (((labels . directories) ...)
- (when (every file-exists? directories)
- (insert-files
- db (package-name package) (package-version package) (package-outputs
package)
- directories))
- (return #t)))))
+ (define stmt-select-package-output
+ (sqlite-prepare db "\
+SELECT output FROM Packages WHERE name = :name AND version = :version"
+ #:cache? #t))
+
+ (define (known-outputs package)
+ ;; Return the list of outputs of PACKAGE already in DB.
+ (sqlite-bind-arguments stmt-select-package-output
+ #:name (package-name package)
+ #:version (package-version package))
+ (match (sqlite-fold cons '() stmt-select-package-output)
+ ((#(outputs ...)) outputs)
+ (() '())))
+
+ (with-monad %store-monad
+ ;; Since calling 'package->derivation' is expensive, do not call it if the
+ ;; outputs of PACKAGE at VERSION are already in DB.
+ (munless (lset= string=?
+ (known-outputs package)
+ (package-outputs package))
+ (mlet %store-monad ((drv (package->derivation package #:graft? #f)))
+ (match (derivation->output-paths drv)
+ (((labels . directories) ...)
+ (when (every file-exists? directories)
+ (insert-files
+ db (package-name package) (package-version package)
(package-outputs package)
+ directories))
+ (return #t)))))))
(define (insert-packages-with-progress db packages insert-package)
"Insert PACKAGES into DB with progress bar reporting, calling INSERT-PACKAGE
