Hello Guix, Ludo, \o/, thanks for the iteration ;) Not that I understood everything yet but indeed, it's faster. I've iterated over your work to: - align calls to that new function - improve some docstrings, and imports, and the help message - drop dead (or redundant) code - make sure the (xdg) folder holding the db is created if needed Please, find enclosed the latest implementation as a patch (somewhat vcs code ;). I've edited commits to mark Ludo as author with his started/amended implementations first [0] (that should be in the patch). For information, I extracted some number from runs to compare our iterations (see the org-file attachment). The first iteration being "extracts packages from the store" and the second one "extracts packages from the system manifest". Those runs happened both on a guixified debian host and a raw guix host (more packages). It seems with the new implementation, we find less a bit less packages but it's faster so i guess it's a tradeoff. It'd be nice to know how it runs on your build farm machine (if you got the time at some point [1]). [0] fwiw, yeah git and magit! :D [1] I noticed (through ml discussions) you all are quite busy at the moment ;) Cheers, -- tony / Antoine R. Dumont (@ardumont) ----------------------------------------------------------------- gpg fingerprint BF00 203D 741A C9D5 46A8 BE07 52E2 E984 0D10 C3B8 Ludovic Courtès writes: > Yay, nice work! > > I toyed a bit with your code and that gave me an idea: instead of the > costly ‘fold-packages’ + ‘package-derivation’, we can iterate over all > the manifests on the system and index packages they refer to. That way, > no need to talk to the daemon, computer derivations, etc. Should be > faster, though of course it still needs to traverse those directories. > > Please find attached a modified version that illustrates that. (We’ll > need version control at some point. :-)) > > Thanks, > Ludo’. > > ;;; GNU Guix --- Functional package management for GNU > ;;; Copyright © 2022 Ludovic Courtès > ;;; > ;;; This file is part of GNU Guix. > ;;; > ;;; GNU Guix is free software; you can redistribute it and/or modify it > ;;; under the terms of the GNU General Public License as published by > ;;; the Free Software Foundation; either version 3 of the License, or (at > ;;; your option) any later version. > ;;; > ;;; GNU Guix is distributed in the hope that it will be useful, but > ;;; WITHOUT ANY WARRANTY; without even the implied warranty of > ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the > ;;; GNU General Public License for more details. > ;;; > ;;; You should have received a copy of the GNU General Public License > ;;; along with GNU Guix. If not, see . > > (define-module (guix extensions index) > #:use-module (guix config) ;; %guix-package-name, ... > #:use-module (guix ui) ;; display G_ > #:use-module (guix scripts) > #:use-module (sqlite3) > #:use-module (ice-9 match) > #:use-module (guix describe) > #:use-module (guix store) > #:use-module (guix monads) > #:autoload (guix combinators) (fold2) > #:autoload (guix grafts) (%graft?) > #:autoload (guix store roots) (gc-roots) > #:use-module (guix derivations) > #:use-module (guix packages) > #:use-module (guix profiles) > #:use-module (guix sets) > #:use-module ((guix utils) #:select (cache-directory)) > #:autoload (guix build utils) (find-files) > #:autoload (gnu packages) (fold-packages) > #:use-module (srfi srfi-1) > #:use-module (srfi srfi-9) > #:use-module (srfi srfi-71) > #:export (guix-index)) > > (define debug #f) > > (define schema > " > create table if not exists Packages ( > id integer primary key autoincrement not null, > name text not null, > version text not null, > unique (name, version) -- add uniqueness constraint > ); > > create table if not exists Directories ( > id integer primary key autoincrement not null, > name text not null, > package integer not null, > foreign key (package) references Packages(id) on delete cascade, > unique (name, package) -- add uniqueness constraint > ); > > create table if not exists Files ( > name text not null, > basename text not null, > directory integer not null, > foreign key (directory) references Directories(id) on delete cascade > unique (name, basename, directory) -- add uniqueness constraint > ); > > create index if not exists IndexFiles on Files(basename);") > > (define (call-with-database file proc) > (let ((db (sqlite-open file))) > (dynamic-wind > (lambda () #t) > (lambda () > (sqlite-exec db schema) > (proc db)) > (lambda () > (sqlite-close db))))) > > (define (insert-files db package version directories) > "Insert files from DIRECTORIES as belonging to PACKAGE at VERSION." > (define stmt-select-package > (sqlite-prepare db "\ > SELECT id FROM Packages WHERE name = :name AND version = :version;" > #:cache? #t)) > > (define stmt-insert-package > (sqlite-prepare db "\ > INSERT OR IGNORE INTO Packages(name, version) -- to avoid spurious writes > VALUES (:name, :version);" > #:cache? #t)) > > (define stmt-select-directory > (sqlite-prepare db "\ > SELECT id FROM Directories WHERE name = :name AND package = :package;" > #:cache? #t)) > > (define stmt-insert-directory > (sqlite-prepare db "\ > INSERT OR IGNORE INTO Directories(name, package) -- to avoid spurious writes > VALUES (:name, :package);" > #:cache? #t)) > > (define stmt-insert-file > (sqlite-prepare db "\ > INSERT OR IGNORE INTO Files(name, basename, directory) > VALUES (:name, :basename, :directory);" > #:cache? #t)) > > (sqlite-exec db "begin immediate;") > (sqlite-bind-arguments stmt-insert-package > #:name package > #:version version) > (sqlite-fold (const #t) #t stmt-insert-package) > > (sqlite-bind-arguments stmt-select-package > #:name package > #:version version) > (match (sqlite-fold cons '() stmt-select-package) > ((#(package-id)) > (when debug > (format #t "(pkg, version, pkg-id): (~a, ~a, ~a)" > package version package-id)) > (pk 'package package-id package) > (for-each (lambda (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) > > (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))))) > directories))) > (sqlite-exec db "commit;")) > > (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) > directories)) > (return #t))))) > > (define (filter-public-current-supported package) > "Filter supported, not hidden (public) and not superseded (current) package." > (and (not (hidden-package? package)) > (not (package-superseded package)) > (supported-package? package))) > > (define (filter-supported-package package) > "Filter supported package (package might be hidden or superseded)." > (and (supported-package? package))) > > (define (no-filter package) "No filtering on package" #t) > > (define* (insert-packages db #:optional (filter-policy filter-public-current-supported)) > "Insert all current packages matching `filter-package-policy` into DB." > (with-store store > (parameterize ((%graft? #f)) > (fold-packages (lambda (package _) > (run-with-store store > (insert-package db package))) > #t > #:select? filter-policy)))) > > > ;;; > ;;; Indexing from local profiles. > ;;; > > (define (all-profiles) > "Return the list of profiles on the system." > (delete-duplicates > (filter-map (lambda (root) > (if (file-exists? (string-append root "/manifest")) > root > (let ((root (string-append root "/profile"))) > (and (file-exists? (string-append root "/manifest")) > root)))) > (gc-roots)))) > > (define (profiles->manifest-entries profiles) > "Return manifest entries for all of PROFILES, without duplicates." > (let loop ((visited (set)) > (profiles profiles) > (entries '())) > (match profiles > (() > entries) > ((profile . rest) > (let* ((manifest (profile-manifest profile)) > (entries visited > (fold2 (lambda (entry lst visited) > (let ((item (manifest-entry-item entry))) > (if (set-contains? visited item) > (values lst visited) > (values (cons entry lst) > (set-insert item > visited))))) > entries > visited > (manifest-transitive-entries manifest)))) > (loop visited rest entries)))))) > > (define (insert-manifest-entry db entry) > "Insert ENTRY, a manifest entry, into DB." > (insert-files db (manifest-entry-name entry) > (manifest-entry-version entry) > (list (manifest-entry-item entry)))) ;FIXME: outputs? > > (define (index-manifests db-file) > "Insert into DB-FILE entries for packages that appear in manifests > available on the system." > (call-with-database db-file > (lambda (db) > (for-each (lambda (entry) > (insert-manifest-entry db entry)) > (let ((lst (profiles->manifest-entries (all-profiles)))) > (pk 'entries (length lst)) > lst))))) > > > ;;; > ;;; Search. > ;;; > > (define-record-type > (package-match name version file) > package-match? > (name package-match-name) > (version package-match-version) > (file package-match-file)) > > (define (matching-packages db file) > "Return unique corresponding to packages containing FILE." > (define lookup-stmt > (sqlite-prepare db "\ > SELECT Packages.name, Packages.version, Directories.name, Files.name > FROM Packages > INNER JOIN Files, Directories > ON files.basename = :file > AND directories.id = files.directory > AND packages.id = directories.package;")) > > (sqlite-bind-arguments lookup-stmt #:file file) > (sqlite-fold (lambda (result lst) > (match result > (#(package version directory file) > (cons (package-match package version > (string-append directory "/" file)) > lst)))) > '() lookup-stmt)) > > > > > (define (index-packages-with-db db-pathname) > "Index packages using db at location DB-PATHNAME." > (call-with-database db-pathname > (lambda (db) > (insert-packages db no-filter)))) > > (define (matching-packages-with-db db-pathname file) > "Compute list of packages referencing FILE using db at DB-PATHNAME." > (call-with-database db-pathname > (lambda (db) > (matching-packages db file)))) > > (define (print-matching-results matches) > "Print the MATCHES matching results." > (for-each (lambda (result) > (format #t "~20a ~a~%" > (string-append (package-match-name result) > "@" (package-match-version result)) > (package-match-file result))) > matches)) > > (define default-db-path > (string-append (cache-directory #:ensure? #f) > "/index/db.sqlite")) > > (define (show-help) > (display (G_ "Usage: guix index [OPTIONS...] [search FILE...] > Without FILE, index (package, file) relationships in the local store. > With 'search FILE', search for packages installing FILEx;x.\n > Note: The internal cache is located at ~/.config/guix/locate-db.sqlite. > See --db-path for customization.\n")) > (newline) > (display (G_ "The valid values for OPTIONS are:")) > (newline) > (display (G_ " > -h, --help Display this help and exit")) > (display (G_ " > -V, --version Display version information and exit")) > (display (G_ " > --db-path=DIR Change default location of the cache db")) > (newline) > (newline) > (display (G_ "The valid values for ARGS are:")) > (newline) > (display (G_ " > search FILE Search for packages installing the FILE (from cache db)")) > (newline) > (show-bug-report-information)) > > (define-command (guix-index . args) > (category extension) > (synopsis "Index packages to allow searching package for a given filename") > > (define (parse-db-args args) > "Parsing of string key=value where we are only interested in 'value'" > (match (string-split args #\=) > ((unused db-path) > db-path) > (_ #f))) > > (define (display-help-and-exit) > (show-help) > (exit 0)) > > (match args > ((or ("-h") ("--help")) > (display-help-and-exit)) > ((or ("-V") ("--version")) > (show-version-and-exit "guix locate")) > ((db-path-args) > (let ((db-path (parse-db-args db-path-args))) > (if db-path > (index-packages-with-db db-path) > (display-help-and-exit)))) > (("search" file) > (let ((matches (matching-packages-with-db default-db-path file))) > (print-matching-results matches) > (exit (pair? matches)))) > ((db-path-args "search" file) > (let ((db-path (parse-db-args db-path-args))) > (if db-path > (let ((matches (matching-packages-with-db db-path file))) > (print-matching-results matches) > (exit (pair? matches))) > (display-help-and-exit)))) > (_ ;; index by default > ;; (index-packages-with-db default-db-path) > (index-manifests default-db-path) > ))) ===File ~/repo/public/guix/guix/add-extension-guix-index.patch=== From d3e658ca1e3ce2715e25450b794d139d3417c74c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Wed, 30 Nov 2022 15:25:21 +0100 Subject: [PATCH 01/18] extensions-index: Add initial implementation from civodul Related to https://lists.gnu.org/archive/html/guix-devel/2022-01/msg00354.html --- guix/extensions/file-database.scm | 199 ++++++++++++++++++++++++++++++ 1 file changed, 199 insertions(+) create mode 100644 guix/extensions/file-database.scm diff --git a/guix/extensions/file-database.scm b/guix/extensions/file-database.scm new file mode 100644 index 0000000000..83aafbc554 --- /dev/null +++ b/guix/extensions/file-database.scm @@ -0,0 +1,199 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2022 Ludovic Courtès +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see . + +(define-module (file-database) + #:use-module (sqlite3) + #:use-module (ice-9 match) + #:use-module (guix store) + #:use-module (guix monads) + #:autoload (guix grafts) (%graft?) + #:use-module (guix derivations) + #:use-module (guix packages) + #:autoload (guix build utils) (find-files) + #:autoload (gnu packages) (fold-packages) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-9) + #:export (file-database)) + +(define schema + " +create table if not exists Packages ( + id integer primary key autoincrement not null, + name text not null, + version text not null +); + +create table if not exists Directories ( + id integer primary key autoincrement not null, + name text not null, + package integer not null, + foreign key (package) references Packages(id) on delete cascade +); + +create table if not exists Files ( + name text not null, + basename text not null, + directory integer not null, + foreign key (directory) references Directories(id) on delete cascade +); + +create index if not exists IndexFiles on Files(basename);") + +(define (call-with-database file proc) + (let ((db (sqlite-open file))) + (dynamic-wind + (lambda () #t) + (lambda () + (sqlite-exec db schema) + (proc db)) + (lambda () + (sqlite-close db))))) + +(define (insert-files db package version directories) + "Insert the files contained in DIRECTORIES as belonging to PACKAGE at +VERSION." + (define last-row-id-stmt + (sqlite-prepare db "SELECT last_insert_rowid();" + #:cache? #t)) + + (define package-stmt + (sqlite-prepare db "\ +INSERT OR REPLACE INTO Packages(name, version) +VALUES (:name, :version);" + #:cache? #t)) + + (define directory-stmt + (sqlite-prepare db "\ +INSERT INTO Directories(name, package) VALUES (:name, :package);" + #:cache? #t)) + + (define file-stmt + (sqlite-prepare db "\ +INSERT INTO Files(name, basename, directory) +VALUES (:name, :basename, :directory);" + #:cache? #t)) + + (sqlite-exec db "begin immediate;") + (sqlite-bind-arguments package-stmt + #:name package + #:version version) + (sqlite-fold (const #t) #t package-stmt) + (match (sqlite-fold cons '() last-row-id-stmt) + ((#(package-id)) + (pk 'package package-id package) + (for-each (lambda (directory) + (define (strip file) + (string-drop file (+ (string-length directory) 1))) + + (sqlite-reset directory-stmt) + (sqlite-bind-arguments directory-stmt + #:name directory + #:package package-id) + (sqlite-fold (const #t) #t directory-stmt) + + (match (sqlite-fold cons '() last-row-id-stmt) + ((#(directory-id)) + (for-each (lambda (file) + ;; If DIRECTORY is a symlink, (find-files + ;; DIRECTORY) returns the DIRECTORY singleton. + (unless (string=? file directory) + (sqlite-reset file-stmt) + (sqlite-bind-arguments file-stmt + #:name (strip file) + #:basename + (basename file) + #:directory + directory-id) + (sqlite-fold (const #t) #t file-stmt))) + (find-files directory))))) + directories) + (sqlite-exec db "commit;")))) + +(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) + directories)) + (return #t))))) + +(define (insert-packages db) + "Insert all the current packages into DB." + (with-store store + (parameterize ((%graft? #f)) + (fold-packages (lambda (package _) + (run-with-store store + (insert-package db package))) + #t + #:select? (lambda (package) + (and (not (hidden-package? package)) + (not (package-superseded package)) + (supported-package? package))))))) + +(define-record-type + (package-match name version file) + package-match? + (name package-match-name) + (version package-match-version) + (file package-match-file)) + +(define (matching-packages db file) + "Return a list of corresponding to packages containing +FILE." + (define lookup-stmt + (sqlite-prepare db "\ +SELECT Packages.name, Packages.version, Directories.name, Files.name +FROM Packages +INNER JOIN Files, Directories +ON files.basename = :file AND directories.id = files.directory AND packages.id = directories.package;")) + + (sqlite-bind-arguments lookup-stmt #:file file) + (sqlite-fold (lambda (result lst) + (match result + (#(package version directory file) + (cons (package-match package version + (string-append directory "/" file)) + lst)))) + '() lookup-stmt)) + + +(define (file-database . args) + (match args + ((_ "populate") + (call-with-database "/tmp/db" + (lambda (db) + (insert-packages db)))) + ((_ "search" file) + (let ((matches (call-with-database "/tmp/db" + (lambda (db) + (matching-packages db file))))) + (for-each (lambda (result) + (format #t "~20a ~a~%" + (string-append (package-match-name result) + "@" (package-match-version result)) + (package-match-file result))) + matches) + (exit (pair? matches)))) + (_ + (format (current-error-port) + "usage: file-database [populate|search] args ...~%") + (exit 1)))) + +(apply file-database (command-line)) -- 2.38.1 From d9139cc86c26f76bc66f7d82868ebf6a03605f76 Mon Sep 17 00:00:00 2001 From: "Antoine R. Dumont (@ardumont)" Date: Thu, 1 Dec 2022 13:36:28 +0100 Subject: [PATCH 02/18] extensions-index: Transform command into `guix locate` extension --- .../{file-database.scm => locate.scm} | 58 ++++++++++++------- 1 file changed, 36 insertions(+), 22 deletions(-) rename guix/extensions/{file-database.scm => locate.scm} (82%) diff --git a/guix/extensions/file-database.scm b/guix/extensions/locate.scm similarity index 82% rename from guix/extensions/file-database.scm rename to guix/extensions/locate.scm index 83aafbc554..1e42f5bad8 100644 --- a/guix/extensions/file-database.scm +++ b/guix/extensions/locate.scm @@ -16,7 +16,8 @@ ;;; You should have received a copy of the GNU General Public License ;;; along with GNU Guix. If not, see . -(define-module (file-database) +(define-module (guix extensions locate) + #:use-module (guix scripts) #:use-module (sqlite3) #:use-module (ice-9 match) #:use-module (guix store) @@ -28,7 +29,7 @@ (define-module (file-database) #:autoload (gnu packages) (fold-packages) #:use-module (srfi srfi-1) #:use-module (srfi srfi-9) - #:export (file-database)) + #:export (guix-locate)) (define schema " @@ -155,8 +156,7 @@ (define-record-type (file package-match-file)) (define (matching-packages db file) - "Return a list of corresponding to packages containing -FILE." + "Return list of corresponding to packages containing FILE." (define lookup-stmt (sqlite-prepare db "\ SELECT Packages.name, Packages.version, Directories.name, Files.name @@ -174,26 +174,40 @@ (define lookup-stmt '() lookup-stmt)) -(define (file-database . args) + +(define (index-packages-with-db db-pathname) + "Index packages using db at location DB-PATHNAME." + (call-with-database db-pathname + (lambda (db) + (insert-packages db)))) + +(define (matching-packages-with-db db-pathname file) + "Compute list of packages referencing FILE using db at DB-PATHNAME." + (call-with-database db-pathname + (lambda (db) + (matching-packages db file)))) + +(define (print-matching-results matches) + "Print the MATCHES matching results." + (for-each (lambda (result) + (format #t "~20a ~a~%" + (string-append (package-match-name result) + "@" (package-match-version result)) + (package-match-file result))) + matches)) + +(define-command (guix-locate . args) + (category extension) + (synopsis "Index packages then search what package declares a given file") (match args - ((_ "populate") - (call-with-database "/tmp/db" - (lambda (db) - (insert-packages db)))) - ((_ "search" file) - (let ((matches (call-with-database "/tmp/db" - (lambda (db) - (matching-packages db file))))) - (for-each (lambda (result) - (format #t "~20a ~a~%" - (string-append (package-match-name result) - "@" (package-match-version result)) - (package-match-file result))) - matches) + (("index") + (index-packages-with-db "/tmp/db")) + (("search" file) + (let ((matches (matching-packages-with-db "/tmp/db" file))) + (print-matching-results matches) (exit (pair? matches)))) (_ (format (current-error-port) - "usage: file-database [populate|search] args ...~%") + "usage: guix locate [index|search] args ...~% ~a" + args) (exit 1)))) - -(apply file-database (command-line)) -- 2.38.1 From eb474f3412ba19320dceda7d08c7f960d00cb898 Mon Sep 17 00:00:00 2001 From: "Antoine R. Dumont (@ardumont)" Date: Thu, 1 Dec 2022 13:45:59 +0100 Subject: [PATCH 03/18] extensions-index: Avoid duplicating the hard-coded db path --- guix/extensions/locate.scm | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/guix/extensions/locate.scm b/guix/extensions/locate.scm index 1e42f5bad8..830dfc49fb 100644 --- a/guix/extensions/locate.scm +++ b/guix/extensions/locate.scm @@ -196,14 +196,18 @@ (define (print-matching-results matches) (package-match-file result))) matches)) +;; TODO: Determine the current guile/guix mechanism to provide configuration +;; for this +(define default-location-db-path "/tmp/db") + (define-command (guix-locate . args) (category extension) (synopsis "Index packages then search what package declares a given file") (match args (("index") - (index-packages-with-db "/tmp/db")) + (index-packages-with-db default-location-db-path)) (("search" file) - (let ((matches (matching-packages-with-db "/tmp/db" file))) + (let ((matches (matching-packages-with-db default-location-db-path file))) (print-matching-results matches) (exit (pair? matches)))) (_ -- 2.38.1 From 309ecd5d5b7cdff012b66cbe9643c34725b22a2d Mon Sep 17 00:00:00 2001 From: "Antoine R. Dumont (@ardumont)" Date: Thu, 1 Dec 2022 13:47:19 +0100 Subject: [PATCH 04/18] extensions-index: Deduplicate lookup matching results --- guix/extensions/locate.scm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/guix/extensions/locate.scm b/guix/extensions/locate.scm index 830dfc49fb..ab0a0403ec 100644 --- a/guix/extensions/locate.scm +++ b/guix/extensions/locate.scm @@ -156,10 +156,10 @@ (define-record-type (file package-match-file)) (define (matching-packages db file) - "Return list of corresponding to packages containing FILE." + "Return unique corresponding to packages containing FILE." (define lookup-stmt (sqlite-prepare db "\ -SELECT Packages.name, Packages.version, Directories.name, Files.name +SELECT DISTINCT Packages.name, Packages.version, Directories.name, Files.name FROM Packages INNER JOIN Files, Directories ON files.basename = :file AND directories.id = files.directory AND packages.id = directories.package;")) -- 2.38.1 From 541615ab6638b1fb418531f961cfb6756b41499b Mon Sep 17 00:00:00 2001 From: "Antoine R. Dumont (@ardumont)" Date: Fri, 2 Dec 2022 14:09:52 +0100 Subject: [PATCH 05/18] extensions-index: Make insertion queries idempotent Prior to this, multiple runs of the index subcommand would append the same packages, directories or files in the db. --- guix/extensions/locate.scm | 71 ++++++++++++++++++++++++-------------- 1 file changed, 45 insertions(+), 26 deletions(-) diff --git a/guix/extensions/locate.scm b/guix/extensions/locate.scm index ab0a0403ec..ce8306531f 100644 --- a/guix/extensions/locate.scm +++ b/guix/extensions/locate.scm @@ -36,14 +36,16 @@ (define schema create table if not exists Packages ( id integer primary key autoincrement not null, name text not null, - version text not null + version text not null, + unique (name, version) -- add uniqueness constraint ); create table if not exists Directories ( id integer primary key autoincrement not null, name text not null, package integer not null, - foreign key (package) references Packages(id) on delete cascade + foreign key (package) references Packages(id) on delete cascade, + unique (name, package) -- add uniqueness constraint ); create table if not exists Files ( @@ -51,6 +53,7 @@ (define schema basename text not null, directory integer not null, foreign key (directory) references Directories(id) on delete cascade + unique (name, basename, directory) -- add uniqueness constraint ); create index if not exists IndexFiles on Files(basename);") @@ -66,64 +69,78 @@ (define (call-with-database file proc) (sqlite-close db))))) (define (insert-files db package version directories) - "Insert the files contained in DIRECTORIES as belonging to PACKAGE at -VERSION." - (define last-row-id-stmt - (sqlite-prepare db "SELECT last_insert_rowid();" + "Insert files from DIRECTORIES as belonging to PACKAGE at VERSION." + (define stmt-select-package + (sqlite-prepare db "\ +SELECT id FROM Packages WHERE name = :name AND version = :version;" #:cache? #t)) - (define package-stmt + (define stmt-insert-package (sqlite-prepare db "\ -INSERT OR REPLACE INTO Packages(name, version) +INSERT OR IGNORE INTO Packages(name, version) -- to avoid spurious writes VALUES (:name, :version);" #:cache? #t)) - (define directory-stmt + (define stmt-select-directory (sqlite-prepare db "\ -INSERT INTO Directories(name, package) VALUES (:name, :package);" +SELECT id FROM Directories WHERE name = :name AND package = :package;" #:cache? #t)) - (define file-stmt + (define stmt-insert-directory (sqlite-prepare db "\ -INSERT INTO Files(name, basename, directory) +INSERT OR IGNORE INTO Directories(name, package) -- to avoid spurious writes +VALUES (:name, :package);" + #:cache? #t)) + + (define stmt-insert-file + (sqlite-prepare db "\ +INSERT OR IGNORE INTO Files(name, basename, directory) VALUES (:name, :basename, :directory);" #:cache? #t)) (sqlite-exec db "begin immediate;") - (sqlite-bind-arguments package-stmt + (sqlite-bind-arguments stmt-insert-package #:name package #:version version) - (sqlite-fold (const #t) #t package-stmt) - (match (sqlite-fold cons '() last-row-id-stmt) + (sqlite-fold (const #t) #t stmt-insert-package) + + (sqlite-bind-arguments stmt-select-package + #:name package + #:version version) + (match (sqlite-fold cons '() stmt-select-package) ((#(package-id)) (pk 'package package-id package) (for-each (lambda (directory) (define (strip file) (string-drop file (+ (string-length directory) 1))) - (sqlite-reset directory-stmt) - (sqlite-bind-arguments directory-stmt + (sqlite-reset stmt-insert-directory) + (sqlite-bind-arguments stmt-insert-directory #:name directory #:package package-id) - (sqlite-fold (const #t) #t directory-stmt) + (sqlite-fold (const #t) #t stmt-insert-directory) - (match (sqlite-fold cons '() last-row-id-stmt) + (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)) (for-each (lambda (file) ;; If DIRECTORY is a symlink, (find-files ;; DIRECTORY) returns the DIRECTORY singleton. (unless (string=? file directory) - (sqlite-reset file-stmt) - (sqlite-bind-arguments file-stmt + (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 file-stmt))) + (sqlite-fold (const #t) #t stmt-insert-file))) (find-files directory))))) - directories) - (sqlite-exec db "commit;")))) + directories))) + (sqlite-exec db "commit;")) (define (insert-package db package) "Insert all the files of PACKAGE into DB." @@ -159,10 +176,12 @@ (define (matching-packages db file) "Return unique corresponding to packages containing FILE." (define lookup-stmt (sqlite-prepare db "\ -SELECT DISTINCT Packages.name, Packages.version, Directories.name, Files.name +SELECT Packages.name, Packages.version, Directories.name, Files.name FROM Packages INNER JOIN Files, Directories -ON files.basename = :file AND directories.id = files.directory AND packages.id = directories.package;")) +ON files.basename = :file + AND directories.id = files.directory + AND packages.id = directories.package;")) (sqlite-bind-arguments lookup-stmt #:file file) (sqlite-fold (lambda (result lst) -- 2.38.1 From 09d5f6b30ac24a8e8261994a1011ddd13082a4bb Mon Sep 17 00:00:00 2001 From: "Antoine R. Dumont (@ardumont)" Date: Fri, 2 Dec 2022 14:10:59 +0100 Subject: [PATCH 06/18] extensions-index: Add debug statement This is conditional in the top-level debug module variable, false by default. --- guix/extensions/locate.scm | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/guix/extensions/locate.scm b/guix/extensions/locate.scm index ce8306531f..3b43ea887e 100644 --- a/guix/extensions/locate.scm +++ b/guix/extensions/locate.scm @@ -31,6 +31,8 @@ (define-module (guix extensions locate) #:use-module (srfi srfi-9) #:export (guix-locate)) +(define debug #f) + (define schema " create table if not exists Packages ( @@ -109,6 +111,9 @@ (define stmt-insert-file #:version version) (match (sqlite-fold cons '() stmt-select-package) ((#(package-id)) + (when debug + (format #t "(pkg, version, pkg-id): (~a, ~a, ~a)" + package version package-id)) (pk 'package package-id package) (for-each (lambda (directory) (define (strip file) @@ -126,6 +131,9 @@ (define (strip file) #: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. -- 2.38.1 From b50267e3d24162cd8c3908bbaa841d13363621e9 Mon Sep 17 00:00:00 2001 From: "Antoine R. Dumont (@ardumont)" Date: Fri, 2 Dec 2022 14:11:50 +0100 Subject: [PATCH 07/18] extensions-index: Play around the packaging filtering functions This keeps the default behavior but allows to change it (by the developer) to determine what's the best policy. --- guix/extensions/locate.scm | 23 ++++++++++++++++------- 1 file changed, 16 insertions(+), 7 deletions(-) diff --git a/guix/extensions/locate.scm b/guix/extensions/locate.scm index 3b43ea887e..9679d643a6 100644 --- a/guix/extensions/locate.scm +++ b/guix/extensions/locate.scm @@ -160,18 +160,27 @@ (define (insert-package db package) directories)) (return #t))))) -(define (insert-packages db) - "Insert all the current packages into DB." +(define (filter-public-current-supported package) + "Filter supported, not hidden (public) and not superseded (current) package." + (and (not (hidden-package? package)) + (not (package-superseded package)) + (supported-package? package))) + +(define (filter-supported-package package) + "Filter supported package (package might be hidden or superseded)." + (and (supported-package? package))) + +(define (no-filter package) "No filtering on package" #t) + +(define* (insert-packages db #:optional (filter-policy filter-public-current-supported)) + "Insert all current packages matching `filter-package-policy` into DB." (with-store store (parameterize ((%graft? #f)) (fold-packages (lambda (package _) (run-with-store store (insert-package db package))) #t - #:select? (lambda (package) - (and (not (hidden-package? package)) - (not (package-superseded package)) - (supported-package? package))))))) + #:select? filter-policy)))) (define-record-type (package-match name version file) @@ -206,7 +215,7 @@ (define (index-packages-with-db db-pathname) "Index packages using db at location DB-PATHNAME." (call-with-database db-pathname (lambda (db) - (insert-packages db)))) + (insert-packages db no-filter)))) (define (matching-packages-with-db db-pathname file) "Compute list of packages referencing FILE using db at DB-PATHNAME." -- 2.38.1 From 3b5c765fc967cef1d6919b66acc2d7872ea1e48c Mon Sep 17 00:00:00 2001 From: "Antoine R. Dumont (@ardumont)" Date: Fri, 2 Dec 2022 15:19:24 +0100 Subject: [PATCH 08/18] extensions-index: Install db in ~/.config/guix/locate-db.sqlite --- guix/extensions/locate.scm | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/guix/extensions/locate.scm b/guix/extensions/locate.scm index 9679d643a6..7d19e64a07 100644 --- a/guix/extensions/locate.scm +++ b/guix/extensions/locate.scm @@ -232,9 +232,12 @@ (define (print-matching-results matches) (package-match-file result))) matches)) -;; TODO: Determine the current guile/guix mechanism to provide configuration -;; for this -(define default-location-db-path "/tmp/db") +(define default-location-db-path + (let ((local-config-path + (and=> (getenv "HOME") + (lambda (home) + (string-append home "/.config/guix/"))))) + (string-append local-config-path "locate-db.sqlite"))) (define-command (guix-locate . args) (category extension) -- 2.38.1 From f101d12acf05c82cf9678d1cffec76cceba9e845 Mon Sep 17 00:00:00 2001 From: "Antoine R. Dumont (@ardumont)" Date: Fri, 2 Dec 2022 17:58:18 +0100 Subject: [PATCH 09/18] extensions-index: Improve cli parsing This unifies with some existing guix commands (import). --- guix/extensions/locate.scm | 80 +++++++++++++++++++++++++++++++++----- 1 file changed, 71 insertions(+), 9 deletions(-) diff --git a/guix/extensions/locate.scm b/guix/extensions/locate.scm index 7d19e64a07..630560b231 100644 --- a/guix/extensions/locate.scm +++ b/guix/extensions/locate.scm @@ -17,9 +17,12 @@ ;;; along with GNU Guix. If not, see . (define-module (guix extensions locate) + #:use-module (guix config) ;; %guix-package-name, ... + #:use-module (guix ui) ;; display G_ #:use-module (guix scripts) #:use-module (sqlite3) #:use-module (ice-9 match) + #:use-module (guix describe) #:use-module (guix store) #:use-module (guix monads) #:autoload (guix grafts) (%graft?) @@ -232,25 +235,84 @@ (define (print-matching-results matches) (package-match-file result))) matches)) -(define default-location-db-path +(define default-db-path (let ((local-config-path (and=> (getenv "HOME") (lambda (home) (string-append home "/.config/guix/"))))) (string-append local-config-path "locate-db.sqlite"))) +(define (show-bug-report-information) + ;; TRANSLATORS: The placeholder indicates the bug-reporting address for this + ;; package. Please add another line saying "Report translation bugs to + ;; ...\n" with the address for translation bugs (typically your translation + ;; team's web or email address). + (format #t (G_ " +Report bugs to: ~a.") %guix-bug-report-address) + (format #t (G_ " +~a home page: <~a>") %guix-package-name %guix-home-page-url) + (format #t (G_ " +General help using Guix and GNU software: <~a>") + ;; TRANSLATORS: Change the "/en" bit of this URL appropriately if + ;; the web site is translated in your language. + (G_ "https://guix.gnu.org/en/help/")) + (newline)) + +(define (show-help) + (display (G_ "Usage: guix locate [OPTIONS...] [ARGS...] +Index packages and search what package declares a given file.\n +By default, the local cache db is located in ~/.config/guix/locate-db.sqlite. +See --db-path for customization.")) + (display (G_ " + index Index current packages from the local store (in cache db)")) + (display (G_ " + search FILE Search for packages that declares FILE (from cache db)")) + (newline) + (display (G_ " + --db-path=DIR Change default location of the cache db")) + (newline) + (display (G_ " + -h, --help Display this help and exit")) + (display (G_ " + -V, --version Display version information and exit")) + (newline) + (show-bug-report-information)) + (define-command (guix-locate . args) (category extension) - (synopsis "Index packages then search what package declares a given file") + (synopsis "Index packages to allow searching package for a given filename") + + (define (parse-db-args args) + "Parsing of string key=value where we are only interested in 'value'" + (match (string-split args #\=) + ((unused db-path) + db-path) + (_ #f))) + + (define (display-help-and-exit) + (show-help) + (exit 0)) + (match args + ((or ("-h") ("--help") ()) + (display-help-and-exit)) + ((or ("-V") ("--version")) + (show-version-and-exit "guix locate")) + ((db-path-args "index") + (let ((db-path (parse-db-args db-path-args))) + (if db-path + (index-packages-with-db db-path) + (display-help-and-exit)))) (("index") - (index-packages-with-db default-location-db-path)) + (index-packages-with-db default-db-path)) (("search" file) - (let ((matches (matching-packages-with-db default-location-db-path file))) + (let ((matches (matching-packages-with-db default-db-path file))) (print-matching-results matches) (exit (pair? matches)))) - (_ - (format (current-error-port) - "usage: guix locate [index|search] args ...~% ~a" - args) - (exit 1)))) + ((db-path-args "search" file) + (let ((db-path (parse-db-args db-path-args))) + (if db-path + (let ((matches (matching-packages-with-db db-path file))) + (print-matching-results matches) + (exit (pair? matches))) + (display-help-and-exit)))))) -- 2.38.1 From 9cb0826a71bdada345de100d98e9b44f3503a75a Mon Sep 17 00:00:00 2001 From: "Antoine R. Dumont (@ardumont)" Date: Fri, 2 Dec 2022 19:13:46 +0100 Subject: [PATCH 10/18] extensions-index: Improve cli options and help message This also renames the cli from locate to index. --- guix/extensions/{locate.scm => index.scm} | 40 +++++++++++++---------- 1 file changed, 22 insertions(+), 18 deletions(-) rename guix/extensions/{locate.scm => index.scm} (93%) diff --git a/guix/extensions/locate.scm b/guix/extensions/index.scm similarity index 93% rename from guix/extensions/locate.scm rename to guix/extensions/index.scm index 630560b231..ab7661dbac 100644 --- a/guix/extensions/locate.scm +++ b/guix/extensions/index.scm @@ -16,7 +16,7 @@ ;;; You should have received a copy of the GNU General Public License ;;; along with GNU Guix. If not, see . -(define-module (guix extensions locate) +(define-module (guix extensions index) #:use-module (guix config) ;; %guix-package-name, ... #:use-module (guix ui) ;; display G_ #:use-module (guix scripts) @@ -32,7 +32,7 @@ (define-module (guix extensions locate) #:autoload (gnu packages) (fold-packages) #:use-module (srfi srfi-1) #:use-module (srfi srfi-9) - #:export (guix-locate)) + #:export (guix-index)) (define debug #f) @@ -259,26 +259,30 @@ (define (show-bug-report-information) (newline)) (define (show-help) - (display (G_ "Usage: guix locate [OPTIONS...] [ARGS...] -Index packages and search what package declares a given file.\n -By default, the local cache db is located in ~/.config/guix/locate-db.sqlite. -See --db-path for customization.")) - (display (G_ " - index Index current packages from the local store (in cache db)")) - (display (G_ " - search FILE Search for packages that declares FILE (from cache db)")) + (display (G_ "Usage: guix index [OPTIONS...] [search FILE...] +Without FILE, index (package, file) relationships in the local store. +With 'search FILE', search for packages installing FILEx;x.\n +Note: The internal cache is located at ~/.config/guix/locate-db.sqlite. +See --db-path for customization.\n")) (newline) - (display (G_ " - --db-path=DIR Change default location of the cache db")) + (display (G_ "The valid values for OPTIONS are:")) (newline) (display (G_ " -h, --help Display this help and exit")) (display (G_ " -V, --version Display version information and exit")) + (display (G_ " + --db-path=DIR Change default location of the cache db")) + (newline) + (newline) + (display (G_ "The valid values for ARGS are:")) + (newline) + (display (G_ " + search FILE Search for packages installing the FILE (from cache db)")) (newline) (show-bug-report-information)) -(define-command (guix-locate . args) +(define-command (guix-index . args) (category extension) (synopsis "Index packages to allow searching package for a given filename") @@ -294,17 +298,15 @@ (define (display-help-and-exit) (exit 0)) (match args - ((or ("-h") ("--help") ()) + ((or ("-h") ("--help")) (display-help-and-exit)) ((or ("-V") ("--version")) (show-version-and-exit "guix locate")) - ((db-path-args "index") + ((db-path-args) (let ((db-path (parse-db-args db-path-args))) (if db-path (index-packages-with-db db-path) (display-help-and-exit)))) - (("index") - (index-packages-with-db default-db-path)) (("search" file) (let ((matches (matching-packages-with-db default-db-path file))) (print-matching-results matches) @@ -315,4 +317,6 @@ (define (display-help-and-exit) (let ((matches (matching-packages-with-db db-path file))) (print-matching-results matches) (exit (pair? matches))) - (display-help-and-exit)))))) + (display-help-and-exit)))) + (_ ;; index by default + (index-packages-with-db default-db-path)))) -- 2.38.1 From f18d1f536bf6b13ec0dd8ee1e865ce21448e3836 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Sun, 4 Dec 2022 14:42:45 +0100 Subject: [PATCH 11/18] extensions-index: Iterate over system manifests to index This should avoid the extra work of discussing with daemon, computing derivations, etc... --- guix/extensions/index.scm | 84 +++++++++++++++++++++++++++++++++++---- 1 file changed, 76 insertions(+), 8 deletions(-) diff --git a/guix/extensions/index.scm b/guix/extensions/index.scm index ab7661dbac..a7a23c6194 100644 --- a/guix/extensions/index.scm +++ b/guix/extensions/index.scm @@ -25,13 +25,19 @@ (define-module (guix extensions index) #:use-module (guix describe) #:use-module (guix store) #:use-module (guix monads) + #:autoload (guix combinators) (fold2) #:autoload (guix grafts) (%graft?) + #:autoload (guix store roots) (gc-roots) #:use-module (guix derivations) #:use-module (guix packages) + #:use-module (guix profiles) + #:use-module (guix sets) + #:use-module ((guix utils) #:select (cache-directory)) #:autoload (guix build utils) (find-files) #:autoload (gnu packages) (fold-packages) #:use-module (srfi srfi-1) #:use-module (srfi srfi-9) + #:use-module (srfi srfi-71) #:export (guix-index)) (define debug #f) @@ -185,6 +191,67 @@ (define* (insert-packages db #:optional (filter-policy filter-public-current-sup #t #:select? filter-policy)))) + +;;; +;;; Indexing from local profiles. +;;; + +(define (all-profiles) + "Return the list of profiles on the system." + (delete-duplicates + (filter-map (lambda (root) + (if (file-exists? (string-append root "/manifest")) + root + (let ((root (string-append root "/profile"))) + (and (file-exists? (string-append root "/manifest")) + root)))) + (gc-roots)))) + +(define (profiles->manifest-entries profiles) + "Return manifest entries for all of PROFILES, without duplicates." + (let loop ((visited (set)) + (profiles profiles) + (entries '())) + (match profiles + (() + entries) + ((profile . rest) + (let* ((manifest (profile-manifest profile)) + (entries visited + (fold2 (lambda (entry lst visited) + (let ((item (manifest-entry-item entry))) + (if (set-contains? visited item) + (values lst visited) + (values (cons entry lst) + (set-insert item + visited))))) + entries + visited + (manifest-transitive-entries manifest)))) + (loop visited rest entries)))))) + +(define (insert-manifest-entry db entry) + "Insert ENTRY, a manifest entry, into DB." + (insert-files db (manifest-entry-name entry) + (manifest-entry-version entry) + (list (manifest-entry-item entry)))) ;FIXME: outputs? + +(define (index-manifests db-file) + "Insert into DB-FILE entries for packages that appear in manifests +available on the system." + (call-with-database db-file + (lambda (db) + (for-each (lambda (entry) + (insert-manifest-entry db entry)) + (let ((lst (profiles->manifest-entries (all-profiles)))) + (pk 'entries (length lst)) + lst))))) + + +;;; +;;; Search. +;;; + (define-record-type (package-match name version file) package-match? @@ -214,6 +281,10 @@ (define lookup-stmt +;;; +;;; CLI +;;; + (define (index-packages-with-db db-pathname) "Index packages using db at location DB-PATHNAME." (call-with-database db-pathname @@ -236,11 +307,8 @@ (define (print-matching-results matches) matches)) (define default-db-path - (let ((local-config-path - (and=> (getenv "HOME") - (lambda (home) - (string-append home "/.config/guix/"))))) - (string-append local-config-path "locate-db.sqlite"))) + (string-append (cache-directory #:ensure? #f) + "/index/db.sqlite")) (define (show-bug-report-information) ;; TRANSLATORS: The placeholder indicates the bug-reporting address for this @@ -261,7 +329,7 @@ (define (show-bug-report-information) (define (show-help) (display (G_ "Usage: guix index [OPTIONS...] [search FILE...] Without FILE, index (package, file) relationships in the local store. -With 'search FILE', search for packages installing FILEx;x.\n +With 'search FILE', search for packages installing FILE.\n Note: The internal cache is located at ~/.config/guix/locate-db.sqlite. See --db-path for customization.\n")) (newline) @@ -318,5 +386,5 @@ (define (display-help-and-exit) (print-matching-results matches) (exit (pair? matches))) (display-help-and-exit)))) - (_ ;; index by default - (index-packages-with-db default-db-path)))) + (_ ;; By default, index + (index-manifests default-db-path)))) -- 2.38.1 From c9b02fc838237ebd7bc38ba7a71587fcdcaf6212 Mon Sep 17 00:00:00 2001 From: "Antoine R. Dumont (@ardumont)" Date: Sun, 4 Dec 2022 14:45:20 +0100 Subject: [PATCH 12/18] extensions-index: Improve help message --- guix/extensions/index.scm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/guix/extensions/index.scm b/guix/extensions/index.scm index a7a23c6194..4a69df326e 100644 --- a/guix/extensions/index.scm +++ b/guix/extensions/index.scm @@ -328,9 +328,9 @@ (define (show-bug-report-information) (define (show-help) (display (G_ "Usage: guix index [OPTIONS...] [search FILE...] -Without FILE, index (package, file) relationships in the local store. +Without argument, indexes (package, file) relationships in the local store. With 'search FILE', search for packages installing FILE.\n -Note: The internal cache is located at ~/.config/guix/locate-db.sqlite. +Note: The internal cache is located at ~/.cache/guix/index/db.sqlite. See --db-path for customization.\n")) (newline) (display (G_ "The valid values for OPTIONS are:")) -- 2.38.1 From d63ef7a97f3fb47b5693b2c1d24bdf276ca6a6a8 Mon Sep 17 00:00:00 2001 From: "Antoine R. Dumont (@ardumont)" Date: Sun, 4 Dec 2022 14:46:04 +0100 Subject: [PATCH 13/18] extensions-index: Improve imports --- guix/extensions/index.scm | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/guix/extensions/index.scm b/guix/extensions/index.scm index 4a69df326e..abaf7df071 100644 --- a/guix/extensions/index.scm +++ b/guix/extensions/index.scm @@ -17,8 +17,10 @@ ;;; along with GNU Guix. If not, see . (define-module (guix extensions index) - #:use-module (guix config) ;; %guix-package-name, ... - #:use-module (guix ui) ;; display G_ + #:use-module ((guix config) #:select (%guix-package-name + %guix-home-page-url + %guix-bug-report-address)) + #:use-module ((guix ui) #:select (G_)) #:use-module (guix scripts) #:use-module (sqlite3) #:use-module (ice-9 match) -- 2.38.1 From 14a9dafb2b927ba8435a26fdea04b00644e3ca3c Mon Sep 17 00:00:00 2001 From: "Antoine R. Dumont (@ardumont)" Date: Sun, 4 Dec 2022 15:52:15 +0100 Subject: [PATCH 14/18] extensions-index: Drop code duplication Import directly the right function from guix ui module. --- guix/extensions/index.scm | 23 +++-------------------- 1 file changed, 3 insertions(+), 20 deletions(-) diff --git a/guix/extensions/index.scm b/guix/extensions/index.scm index abaf7df071..c40edc7944 100644 --- a/guix/extensions/index.scm +++ b/guix/extensions/index.scm @@ -17,10 +17,9 @@ ;;; along with GNU Guix. If not, see . (define-module (guix extensions index) - #:use-module ((guix config) #:select (%guix-package-name - %guix-home-page-url - %guix-bug-report-address)) - #:use-module ((guix ui) #:select (G_)) + #:use-module ((guix i18n) #:select (G_)) + #:use-module ((guix ui) #:select (show-version-and-exit + show-bug-report-information)) #:use-module (guix scripts) #:use-module (sqlite3) #:use-module (ice-9 match) @@ -312,22 +311,6 @@ (define default-db-path (string-append (cache-directory #:ensure? #f) "/index/db.sqlite")) -(define (show-bug-report-information) - ;; TRANSLATORS: The placeholder indicates the bug-reporting address for this - ;; package. Please add another line saying "Report translation bugs to - ;; ...\n" with the address for translation bugs (typically your translation - ;; team's web or email address). - (format #t (G_ " -Report bugs to: ~a.") %guix-bug-report-address) - (format #t (G_ " -~a home page: <~a>") %guix-package-name %guix-home-page-url) - (format #t (G_ " -General help using Guix and GNU software: <~a>") - ;; TRANSLATORS: Change the "/en" bit of this URL appropriately if - ;; the web site is translated in your language. - (G_ "https://guix.gnu.org/en/help/")) - (newline)) - (define (show-help) (display (G_ "Usage: guix index [OPTIONS...] [search FILE...] Without argument, indexes (package, file) relationships in the local store. -- 2.38.1 From ea1d8216bfe5f487de24d883891b6e07c8536cdd Mon Sep 17 00:00:00 2001 From: "Antoine R. Dumont (@ardumont)" Date: Sun, 4 Dec 2022 16:01:33 +0100 Subject: [PATCH 15/18] extensions-index: Drop dead code we read from local profiles now --- guix/extensions/index.scm | 42 ++------------------------------------- 1 file changed, 2 insertions(+), 40 deletions(-) diff --git a/guix/extensions/index.scm b/guix/extensions/index.scm index c40edc7944..a7c518e903 100644 --- a/guix/extensions/index.scm +++ b/guix/extensions/index.scm @@ -160,38 +160,6 @@ (define (strip file) directories))) (sqlite-exec db "commit;")) -(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) - directories)) - (return #t))))) - -(define (filter-public-current-supported package) - "Filter supported, not hidden (public) and not superseded (current) package." - (and (not (hidden-package? package)) - (not (package-superseded package)) - (supported-package? package))) - -(define (filter-supported-package package) - "Filter supported package (package might be hidden or superseded)." - (and (supported-package? package))) - -(define (no-filter package) "No filtering on package" #t) - -(define* (insert-packages db #:optional (filter-policy filter-public-current-supported)) - "Insert all current packages matching `filter-package-policy` into DB." - (with-store store - (parameterize ((%graft? #f)) - (fold-packages (lambda (package _) - (run-with-store store - (insert-package db package))) - #t - #:select? filter-policy)))) - ;;; ;;; Indexing from local profiles. @@ -209,7 +177,7 @@ (define (all-profiles) (gc-roots)))) (define (profiles->manifest-entries profiles) - "Return manifest entries for all of PROFILES, without duplicates." + "Return deduplicated manifest entries across all PROFILES." (let loop ((visited (set)) (profiles profiles) (entries '())) @@ -286,12 +254,6 @@ (define lookup-stmt ;;; CLI ;;; -(define (index-packages-with-db db-pathname) - "Index packages using db at location DB-PATHNAME." - (call-with-database db-pathname - (lambda (db) - (insert-packages db no-filter)))) - (define (matching-packages-with-db db-pathname file) "Compute list of packages referencing FILE using db at DB-PATHNAME." (call-with-database db-pathname @@ -358,7 +320,7 @@ (define (display-help-and-exit) ((db-path-args) (let ((db-path (parse-db-args db-path-args))) (if db-path - (index-packages-with-db db-path) + (index-manifests db-path) (display-help-and-exit)))) (("search" file) (let ((matches (matching-packages-with-db default-db-path file))) -- 2.38.1 From 8454f9f417c2781fded2c26a1b920174991ac1dc Mon Sep 17 00:00:00 2001 From: "Antoine R. Dumont (@ardumont)" Date: Sun, 4 Dec 2022 16:12:10 +0100 Subject: [PATCH 16/18] extensions-index: Rework docstrings --- guix/extensions/index.scm | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/guix/extensions/index.scm b/guix/extensions/index.scm index a7c518e903..1c23d9a4f1 100644 --- a/guix/extensions/index.scm +++ b/guix/extensions/index.scm @@ -166,7 +166,7 @@ (define (strip file) ;;; (define (all-profiles) - "Return the list of profiles on the system." + "Return the list of system profiles." (delete-duplicates (filter-map (lambda (root) (if (file-exists? (string-append root "/manifest")) @@ -200,14 +200,13 @@ (define (profiles->manifest-entries profiles) (loop visited rest entries)))))) (define (insert-manifest-entry db entry) - "Insert ENTRY, a manifest entry, into DB." + "Insert a manifest ENTRY into DB." (insert-files db (manifest-entry-name entry) (manifest-entry-version entry) (list (manifest-entry-item entry)))) ;FIXME: outputs? (define (index-manifests db-file) - "Insert into DB-FILE entries for packages that appear in manifests -available on the system." + "Insert packages entries into DB-FILE from the system manifests." (call-with-database db-file (lambda (db) (for-each (lambda (entry) -- 2.38.1 From 98f9899d479cd62e93b86fab3448b2024db02621 Mon Sep 17 00:00:00 2001 From: "Antoine R. Dumont (@ardumont)" Date: Sun, 4 Dec 2022 16:12:24 +0100 Subject: [PATCH 17/18] extensions-index: Fix warning according to repl suggestion --- guix/extensions/index.scm | 1 + 1 file changed, 1 insertion(+) diff --git a/guix/extensions/index.scm b/guix/extensions/index.scm index 1c23d9a4f1..42c2051f13 100644 --- a/guix/extensions/index.scm +++ b/guix/extensions/index.scm @@ -23,6 +23,7 @@ (define-module (guix extensions index) #:use-module (guix scripts) #:use-module (sqlite3) #:use-module (ice-9 match) + #:use-module (ice-9 format) #:use-module (guix describe) #:use-module (guix store) #:use-module (guix monads) -- 2.38.1 From bb80ad696e1a47651f2dc4a7c74ea577372c61b5 Mon Sep 17 00:00:00 2001 From: "Antoine R. Dumont (@ardumont)" Date: Sun, 4 Dec 2022 16:20:01 +0100 Subject: [PATCH 18/18] extensions-index: Ensure directory holding the db is created if needed. The creation is ignore if already present. --- guix/extensions/index.scm | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/guix/extensions/index.scm b/guix/extensions/index.scm index 42c2051f13..627dddc119 100644 --- a/guix/extensions/index.scm +++ b/guix/extensions/index.scm @@ -208,6 +208,10 @@ (define (insert-manifest-entry db entry) (define (index-manifests db-file) "Insert packages entries into DB-FILE from the system manifests." + (let ((db-dirpath (dirname db-file))) + (unless (file-exists? db-dirpath) + (mkdir db-dirpath))) + (call-with-database db-file (lambda (db) (for-each (lambda (entry) -- 2.38.1 ============================================================ ===File ~/repo/private/org/guix/guix-extensions-index.org=== #+title: Bootstrap guix index (search) #+author: civodul, ardumont Let's have a means to lookup from file to package holding that file: * sources - [[https://lists.gnu.org/archive/html/guix-devel/2022-01/msg00354.html][Initial discussion]] - [[https://web.fdn.fr/~lcourtes/pastebin/file-database.scm.html][Latest source]] - [[https://fulbert.neocities.org/guix/10-years-of-guix/simon-tournier-guix-repl/guix-cookbook/minimal-example.html][Extension mechanism]] + [[https://10years.guix.gnu.org/video/guix-repl-to-infinity-and-beyond/][demo presentation]] - [[https://issues.guix.gnu.org/58339][Simple extension package]] * kickoff discussion to propose contribution in irc #+begin_src txt 11:54 civodul: hello, i had a look at the discussion you pointed me (on store "file search"), it's definitely interesting (and the offline part is really what i need) 11:54 what's a way forward? 11:54 (if any) 11:55 (can i help or something? ;) 11:56 (i'm a somewhat "miscelleanous" lisper so) 12:01 ardumont: hi! sure! i guess you could champion discussions & development of such a tool 12:02 so it's mostly about finding out how to make the info available 12:03 perhaps there could be a default mode of operation downloading the database from some server 12:03 and an other mode of operation where it'd use purely local knowledge 12:03 regarding the implementation, the end discussion talked about compression, is that solely in regards to serving the result from somewhere? 12:03 yes 12:03 otherwise it doesn't really matter 12:03 (or is that some implementation adaptation so the tool is doing it?) 12:03 i have my answer ;) 12:04 this is the latest version i have: https://web.fdn.fr/~lcourtes/pastebin/file-database.scm.html 12:05 thx, where should that live? 12:06 (in the end i mean) in the guix repo in a branch? 12:07 (we can always sort out the details of what's there to do regarding licenses and whatnot, i'll comply to whatever is required) 12:17 hey ardumont :-) 12:17 civodul: no promise on eta yet but i'll check what i can do (i got one last question below your last answer, sorry, i had forgotten to highlight you ;) 12:17 hello zimoun ;) 12:17 civodul: the link fails for me 12:17 ardumont: in the end it would be part of Guix 12:17 that's the kind of tool that's generally useful 12:17 yes 12:17 or via an extension? 12:18 civodul: -^ 12:18 i was gonna ask, is guix providing a way to extend the guix cli through extension already? 12:18 it can start its life as an extension, sure 12:18 (since it's lisp and all that, somehow that makes sense to me ;) 12:18 but the way i see it it should be part of Guix proper at some point 12:18 ardumont: yes, exemples are here https://issues.guix.gnu.org/58463 12:19 nice 12:19 zimoun demoed extensions at the 10 years :-) 12:19 yep 12:19 (oh i missed it, i was not there yet) 12:19 (or already left ¯\_(ツ)_/¯) 12:19 https://10years.guix.gnu.org/video/guix-repl-to-infinity-and-beyond/ 12:20 i like that title ;) 12:20 (thx) 12:21 civodul: I think we should go a path where we have more extensions and less all-in subcommands. For sure, tradeoff with maintenance. :-) 12:21 yes, that'd make sense ^ #+end_src * Some Metrics ** iteration 1 (over nix store) *** guixified debian yavin4: #+begin_src sh $ time guix index ;;; (package 286 "xcb-util-renderutil") guix index 121.88s user 2.49s system 138% cpu 1:29.82 total $ sqlite3 ~/.config/guix/locate-db.sqlite SQLite version 3.34.1 2021-01-20 14:10:07 Enter ".help" for usage hints. sqlite> select count(*) from files; select count(*) from directories; select count(*) from packages; 50913 328 284 $ ls -lah ~/.config/guix/locate-db.sqlite -rw-r--r-- 1 tony tony 8.9M Dec 3 10:49 /home/tony/.config/guix/locate-db.sqlite #+end_src *** guix system node dagobah: #+begin_src sh $ time guix index ;;; (package 1 "acl") ;;; (package 2 "inetutils") ... ;;; (package 753 "xauth") guix index 413.55s user 6.16s system 124% cpu 5:36.67 total $ ls -lah ~/.config/guix/locate-db.sqlite -rw-r--r-- 1 tony users 30M Dec 3 10:42 /home/tony/.config/guix/locate-db.sqlite $ sqlite3 ~/.config/guix/locate-db.sqlite SQLite version 3.39.3 2022-09-05 11:02:23 Enter ".help" for usage hints. sqlite> select count(*) from files; select count(*) from directories; select count(*) from packages; 162035 830 749 #+end_src ** iteration 2 (over system manifests) *** guixified debian #+begin_src sh $ time guix index ;;; (package 110 "guix") guix index 1.30s user 0.34s system 94% cpu 1.735 total $ sqlite3 ~/.cache/guix/index/db.sqlite SQLite version 3.34.1 2021-01-20 14:10:07 Enter ".help" for usage hints. sqlite> select count(*) from files; select count(*) from directories; select count(*) from packages; 34339 110 101 ls -lah ~/.cache/guix/index/db.sqlite -rw-r--r-- 1 tony tony 5.8M Dec 4 16:22 /home/tony/.cache/guix/index/db.sqlite #+end_src *** guix host #+begin_src sh $ time guix index ;;; (package 515 "guix") guix index 11.54s user 2.22s system 87% cpu 15.693 total dagobah% sqlite3 ~/.cache/guix/index/db.sqlite SQLite version 3.39.3 2022-09-05 11:02:23 Enter ".help" for usage hints. sqlite> select count(*) from files; select count(*) from directories; select count(*) from packages; 152947 515 354 sqlite> .quit dagobah% ls -lah ~/.cache/guix/index/db.sqlite -rw-r--r-- 1 tony users 29M Dec 4 16:26 /home/tony/.cache/guix/index/db.sqlite #+end_src ============================================================