14/20: squash! Remove actions; auto-update database when needed.

[guix-commits]

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

commit 9c817d6bfa0eea38702a46df1ffa9b6ce395daae
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Sat Jun 3 19:47:12 2023 +0200

    squash! Remove actions; auto-update database when needed.
---
 guix/scripts/index.scm | 111 ++++++++++++++++++++-----------------------------
 tests/guix-index.sh    |  25 ++++-------
 2 files changed, 53 insertions(+), 83 deletions(-)

diff --git a/guix/scripts/index.scm b/guix/scripts/index.scm
index 6a6316534a..af6fc41bf7 100644
--- a/guix/scripts/index.scm
+++ b/guix/scripts/index.scm
@@ -19,7 +19,7 @@
 
 (define-module (guix scripts index)
   #:use-module ((guix config) #:select (%localstatedir))
-  #:use-module ((guix i18n) #:select (G_))
+  #:use-module (guix i18n)
   #:use-module ((guix ui)
                 #:select (show-version-and-exit
                           show-bug-report-information
@@ -39,8 +39,8 @@
   #:use-module (guix derivations)
   #:use-module (guix packages)
   #:use-module (guix profiles)
-  #:use-module ((guix progress) #:select (progress-reporter/bar
-                                          call-with-progress-reporter))
+  #:autoload   (guix progress) (progress-reporter/bar
+                                call-with-progress-reporter)
   #:use-module (guix sets)
   #:use-module ((guix utils) #:select (cache-directory))
   #:autoload   (guix build utils) (find-files mkdir-p)
@@ -505,23 +505,15 @@ See --database for customization.\n"))
            (lambda args (show-help) (exit 0)))
    (option '(#\V "version") #f #f
            (lambda (opt name arg result)
-             (catch 'quit
-               (lambda ()
-                 (show-version-and-exit "guix index"))
-               (const #f))
-             (catch 'sqlite-error
-               (lambda ()
-                 (let ((database ((assoc-ref result 'database)
-                                  (eq? (assoc-ref result 'action) 'index))))
-                   (info (G_ "database file '~a', schema version ~a~%")
-                         database (read-version-from-db database))))
-               (const #f))
-             (exit 0)))
+             (show-version-and-exit "guix index")))
    ;; index data out of the method (store or package)
    (option '(#\d "database") #f #t
            (lambda (opt name arg result)
              (alist-cons 'database (const arg)
                          (alist-delete 'database result))))
+   (option '(#\u "update") #f #f
+           (lambda (opt name arg result)
+             (alist-cons 'update? #t result)))
 
    ;; index data out of the method (store or package)
    (option '(#\m "method") #f #t
@@ -539,50 +531,27 @@ See --database for customization.\n"))
 
 (define-command (guix-index . args)
   (category packaging)
-  (synopsis "Index packages to search package for a given filename")
-
-  (define (parse-sub-command arg result)
-    ;; Parse sub-command ARG and augment RESULT accordingly.
-    (if (assoc-ref result 'action)
-        (alist-cons 'argument arg result)
-        (let ((action (string->symbol arg)))
-          (case action
-            ((search)
-             (alist-cons 'action action result))
-            (else (leave (G_ "~a: unknown action~%") action))))))
-
-  (define (match-pair car)
-    ;; Return a procedure that matches a pair with CAR.
-    (match-lambda
-      ((head . tail)
-       (and (eq? car head) tail))
-      (_ #f)))
-
-  (define (option-arguments opts)
-    ;; Extract the plain arguments from OPTS.
-    (let* ((args   (reverse (filter-map (match-pair 'argument) opts)))
-           (count  (length args))
-           (action (or (assoc-ref opts 'action) 'index)))
-      (define (fail)
-        (leave (G_ "wrong number of arguments for action '~a'~%")
-               action))
-
-      (alist-cons 'argument (string-concatenate args)
-                  (alist-delete 'argument
-                                (alist-cons 'action action
-                                            (alist-delete 'action opts))))))
+  (synopsis "search for packages providing a given file")
+
+  (define (old? time)
+    ;; Return true if TIME denotes an "old" time.
+    (>= (- (current-time) time)
+        (* 2 30 (* 24 60 60))))
 
   (with-error-handling
     (let* ((opts     (parse-command-line args %options
                                          (list %default-options)
-                                         #:build-options? #f ;no builds
+                                         #:build-options? #f
                                          #:argument-handler
-                                         parse-sub-command))
-           (args     (option-arguments opts))
-           (action   (assoc-ref args 'action))
-           (database ((assoc-ref args 'database)
-                      (eq? action 'index)))
-           (method   (assoc-ref args 'method)))
+                                         (lambda (arg result)
+                                           (alist-cons 'argument arg result))))
+           (update?  (assoc-ref opts 'update?))
+           (database ((assoc-ref opts 'database) update?))
+           (method   (assoc-ref opts 'method))
+           (files    (reverse (filter-map (match-lambda
+                                            (('argument . arg) arg)
+                                            (_ #f))
+                                          opts))))
       (define (populate-database database)
         (mkdir-p (dirname database))
         ;; Migrate/initialize db to schema at version application-version
@@ -592,16 +561,24 @@ See --database for customization.\n"))
             (index-packages-from-manifests-with-db database)
             (index-packages-from-store-with-db database)))
 
-      (match action
-        ('search
-         (unless (file-exists? database)
-           (info (G_ "indexing files from ~a...~%") (%store-prefix))
-           (populate-database database))
-         (let* ((file (assoc-ref args 'argument))
-                (matches (matching-packages-with-db database file)))
-           (print-matching-results matches)
-           (or (not (null? matches))
-               (leave (G_ "file '~a' not be found in indexed packages~%")
-                      file))))
-        ('index
-         (populate-database database))))))
+      ;; Populate the database if needed.
+      (let ((stat (stat database #f)))
+        (when (or update?
+                  (not stat)
+                  (old? (stat:mtime stat)))
+          (info (G_ "indexing files from ~a...~%") (%store-prefix))
+          (populate-database database)))
+
+      (match (append-map (lambda (file)
+                           (matching-packages-with-db database file))
+                         files)
+        (()
+         (if (null? files)
+             (unless update?
+               (leave (G_ "no files to search for~%")))
+             (leave (N_ "file~{ '~a'~} not found in database '~a'~%"
+                        "files~{ '~a'~} not found in database '~a'~%"
+                        (length files))
+                    files database)))
+        (matches
+         (print-matching-results matches))))))
diff --git a/tests/guix-index.sh b/tests/guix-index.sh
index 104cc11647..3c5fa6753e 100755
--- a/tests/guix-index.sh
+++ b/tests/guix-index.sh
@@ -41,33 +41,26 @@ cmd_manifests="guix index --database=$tmpdb_manifests 
--method=manifests"
 cmd_store="guix index --database=$tmpdb_store --method=store"
 
 # Lookup without any db should fail.
-! guix index --database="$tmpdb_manifests" search guile
-! guix index --database="$tmpdb_store" search guile
-
-# Initializing db with bare store should work.
-$cmd_manifests
+guix index --database="$tmpdb_manifests" guile && false
+guix index --database="$tmpdb_store" guile && false
 
 # Lookup without anything in db should yield no results because the indexer
 # didn't stumble upon any profile.
-test -z "$(guix index --database="$tmpdb_manifests" search guile)"
+test -z "$(guix index --database="$tmpdb_manifests" guile)"
 
 # Install a package.
 guix package --bootstrap --install guile-bootstrap \
      --profile="$tmpdir/profile"
 
-# Both indexation call should work.
-# Testing indexation should work for both method
-$cmd_manifests
-
 # Look for 'guile'.
-$cmd_manifests search guile
-$cmd_manifests search guile | grep $(guix build guile-bootstrap)/bin/guile
-$cmd_manifests search boot-9.scm | grep ^guile-bootstrap
+$cmd_manifests --update
+$cmd_manifests guile | grep "$(guix build guile-bootstrap)/bin/guile"
+$cmd_manifests boot-9.scm | grep ^guile-bootstrap
 
 if $RUN_EXPENSIVE_TESTS
 then
     $cmd_store
-    $cmd_store search guile
-    $cmd_store search guile | grep $(guix build guile-bootstrap)/bin/guile
-    $cmd_store search boot-9.scm | grep ^guile-bootstrap
+    $cmd_store guile
+    $cmd_store guile | grep "$(guix build guile-bootstrap)/bin/guile"
+    $cmd_store boot-9.scm | grep ^guile-bootstrap
 fi