07/20: squash! Don't insert directory if it's already present.

[guix-commits]

civodul pushed a commit to branch wip-guix-index
in repository guix.

commit 3e3847aa1902a994c9c34135f38cf8ea15a556fd
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Sun Apr 2 23:48:47 2023 +0200

    squash! Don't insert directory if it's already present.
---
 guix/scripts/index.scm | 60 ++++++++++++++++++++++++++++++--------------------
 1 file changed, 36 insertions(+), 24 deletions(-)

diff --git a/guix/scripts/index.scm b/guix/scripts/index.scm
index 108c98dbed..8027f87ebf 100644
--- a/guix/scripts/index.scm
+++ b/guix/scripts/index.scm
@@ -118,6 +118,16 @@ add column output text;
       (lambda () (proc db))
       (lambda () (sqlite-close db)))))
 
+(define (last-insert-row-id db)        ;XXX: copied from (guix store database)
+  ;; XXX: (sqlite3) currently lacks bindings for 'sqlite3_last_insert_rowid'.
+  ;; Work around that.
+  (define stmt
+    (sqlite-prepare db "SELECT last_insert_rowid();"
+                    #:cache? #t))
+  (match (sqlite-fold cons '() stmt)
+    ((#(id)) id)
+    (_ #f)))
+
 (define (insert-version db version)
   "Insert application VERSION into the DB."
   (define stmt-insert-version
@@ -194,34 +204,36 @@ VALUES (:name, :basename, :directory);"
                  (define (strip file)
                    (string-drop file (+ (string-length directory) 1)))
 
-                 (sqlite-reset stmt-insert-directory)
-                 (sqlite-bind-arguments stmt-insert-directory
-                                        #:name directory
-                                        #:package package-id)
-                 (sqlite-fold (const #t) #t stmt-insert-directory)
-
+                 ;; If DIRECTORY is already present in the database, skip it.
                  (sqlite-reset stmt-select-directory)
                  (sqlite-bind-arguments stmt-select-directory
                                         #:name directory
                                         #:package package-id)
-                 (match (sqlite-fold cons '() stmt-select-directory)
-                   ((#(directory-id))
-                    (when debug
-                      (format #t "(name, package, dir-id): (~a, ~a, ~a)\n"
-                              directory package-id directory-id))
-                    (for-each (lambda (file)
-                                ;; If DIRECTORY is a symlink, (find-files
-                                ;; DIRECTORY) returns the DIRECTORY singleton.
-                                (unless (string=? file directory)
-                                  (sqlite-reset stmt-insert-file)
-                                  (sqlite-bind-arguments stmt-insert-file
-                                                         #:name (strip file)
-                                                         #:basename
-                                                         (basename file)
-                                                         #:directory
-                                                         directory-id)
-                                  (sqlite-fold (const #t) #t 
stmt-insert-file)))
-                              (find-files directory)))))
+                 (when (null? (sqlite-fold cons '() stmt-select-directory))
+                   ;; DIRECTORY is missing so insert it and traverse it.
+                   (sqlite-reset stmt-insert-directory)
+                   (sqlite-bind-arguments stmt-insert-directory
+                                          #:name directory
+                                          #:package package-id)
+                   (sqlite-fold (const #t) #t stmt-insert-directory)
+
+                   (let ((directory-id (last-insert-row-id db)))
+                     (when debug
+                       (format #t "(name, package, dir-id): (~a, ~a, ~a)\n"
+                               directory package-id directory-id))
+                     (for-each (lambda (file)
+                                 ;; If DIRECTORY is a symlink, (find-files
+                                 ;; DIRECTORY) returns the DIRECTORY singleton.
+                                 (unless (string=? file directory)
+                                   (sqlite-reset stmt-insert-file)
+                                   (sqlite-bind-arguments stmt-insert-file
+                                                          #:name (strip file)
+                                                          #:basename
+                                                          (basename file)
+                                                          #:directory
+                                                          directory-id)
+                                   (sqlite-fold (const #t) #t 
stmt-insert-file)))
+                               (find-files directory)))))
                directories)))
   (sqlite-exec db "commit;"))