06/06: squash! '--stats'

[guix-commits]

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

commit b54e985e3f669ac05b4883bcd04c55ef56008574
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Wed Jun 7 23:37:31 2023 +0200

    squash! '--stats'
---
 doc/guix.texi           |   3 ++
 guix/scripts/locate.scm | 119 +++++++++++++++++++++++++++++-------------------
 tests/guix-locate.sh    |   3 ++
 3 files changed, 79 insertions(+), 46 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 833b1fd9b4..462cffbd96 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -4489,6 +4489,9 @@ Interpret @var{file}@dots{} as @dfn{glob 
patterns}---patterns that may
 include wildcards, such as @samp{*.scm} to denote all files ending in
 @samp{.scm}.
 
+@item --stats
+Display database statistics.
+
 @item --update
 @itemx -u
 Update the file database.
diff --git a/guix/scripts/locate.scm b/guix/scripts/locate.scm
index f5de02cf2c..b5d8671d9c 100644
--- a/guix/scripts/locate.scm
+++ b/guix/scripts/locate.scm
@@ -221,6 +221,29 @@ user or system."
   (sqlite-exec db "COMMIT;")
   (sqlite-exec db "VACUUM;"))
 
+(define (print-statistics file)
+  "Print statistics about the database in FILE."
+  (define (count db table)
+    (define stmt
+      (sqlite-prepare
+       db (string-append "SELECT COUNT(*) FROM " table ";")))
+
+    (match (sqlite-fold cons '() stmt)
+      ((#(number)) number)))
+
+  (call-with-database file
+    (lambda (db)
+      (format #t (G_ "schema version:\t~a~%")
+              (read-version db))
+      (format #t (G_ "number of packages:\t~9h~%")
+              (count db "Packages"))
+      (format #t (G_ "number of files:\t~9h~%")
+              (count db "Files"))
+      (format #t (G_ "database size:\t~9h MiB~%")
+              (inexact->exact
+               (round (/ (stat:size (stat file))
+                         (expt 2 20))))))))
+
 
 ;;;
 ;;; Indexing from local packages.
@@ -492,6 +515,8 @@ ON " match-stmt "
 Locate FILE and return the list of packages that contain it.\n"))
   (display (G_ "
   -g, --glob          interpret FILE as a glob pattern"))
+  (display (G_ "
+      --stats         display database statistics"))
   (display (G_ "
   -u, --update        force a database update"))
   (display (G_ "
@@ -510,35 +535,35 @@ Locate FILE and return the list of packages that contain 
it.\n"))
   (show-bug-report-information))
 
 (define %options
-  (list
-   (option '(#\h "help") #f #f
-           (lambda args (show-help) (exit 0)))
-   (option '(#\V "version") #f #f
-           (lambda (opt name arg result)
-             (show-version-and-exit "guix locate")))
-   (option '(#\g "glob") #f #f
-           (lambda (opt name arg result)
-             (alist-cons 'glob? #t result)))
-   (option '("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)))
-   (option '("clear") #f #f
-           (lambda (opt name arg result)
-             (alist-cons 'clear? #t result)))
-
-   ;; index data out of the method (store or package)
-   (option '(#\m "method") #f #t
-           (lambda (opt name arg result)
-             (match arg
-               ((or "manifests" "store")
-                (alist-cons 'method (string->symbol arg)
-                            (alist-delete 'method result)))
-               (_
-                (leave (G_ "~a: unknown indexing method~%"))))))))
+  (list (option '(#\h "help") #f #f
+                (lambda args (show-help) (exit 0)))
+        (option '(#\V "version") #f #f
+                (lambda (opt name arg result)
+                  (show-version-and-exit "guix locate")))
+        (option '(#\g "glob") #f #f
+                (lambda (opt name arg result)
+                  (alist-cons 'glob? #t result)))
+        (option '("stats") #f #f
+                (lambda (opt name arg result)
+                  (alist-cons 'stats? #t result)))
+        (option '("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)))
+        (option '("clear") #f #f
+                (lambda (opt name arg result)
+                  (alist-cons 'clear? #t result)))
+        (option '(#\m "method") #f #t
+                (lambda (opt name arg result)
+                  (match arg
+                    ((or "manifests" "store")
+                     (alist-cons 'method (string->symbol arg)
+                                 (alist-delete 'method result)))
+                    (_
+                     (leave (G_ "~a: unknown indexing method~%"))))))))
 
 (define %default-options
   `((database . ,suitable-database)
@@ -611,20 +636,22 @@ Locate FILE and return the list of packages that contain 
it.\n"))
           (info (G_ "indexing files from ~a...~%") (%store-prefix))
           (populate-database database clear?)))
 
-      (match (call-with-database database
-               (lambda (db)
-                 (append-map (lambda (file)
-                               (matching-packages db file
-                                                  #:glob? glob?))
-                             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
-         (leave-on-EPIPE
-          (print-matching-results matches)))))))
+      (if (assoc-ref opts 'stats?)
+          (print-statistics database)
+          (match (call-with-database database
+                   (lambda (db)
+                     (append-map (lambda (file)
+                                   (matching-packages db file
+                                                      #:glob? glob?))
+                                 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
+             (leave-on-EPIPE
+              (print-matching-results matches))))))))
diff --git a/tests/guix-locate.sh b/tests/guix-locate.sh
index a1c9e9506a..43f8ba53b0 100755
--- a/tests/guix-locate.sh
+++ b/tests/guix-locate.sh
@@ -60,6 +60,9 @@ $cmd_manifests boot-9.scm | grep ^guile-bootstrap
 # Using a glob pattern.
 $cmd_manifests -g '*.scm' | grep "^guile-bootstrap.*boot-9"
 
+# Statistics.
+$cmd_manifests --stats
+
 if $RUN_EXPENSIVE_TESTS
 then
     $cmd_store --update