[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
02/07: DRAFT Add 'guix index'.
|
From: |
guix-commits |
|
Subject: |
02/07: DRAFT Add 'guix index'. |
|
Date: |
Sun, 2 Apr 2023 17:50:15 -0400 (EDT) |
civodul pushed a commit to branch wip-guix-index
in repository guix.
commit ef6dfe59c45806a2a8965afb05ae292245912154
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Wed Nov 30 15:25:21 2022 +0100
DRAFT Add 'guix index'.
DRAFT: Need to squash other commits and add doc.
Initial implementation from
<https://lists.gnu.org/archive/html/guix-devel/2022-01/msg00354.html>.
* guix/scripts/index.scm, tests/guix-index.sh: New files.
* Makefile.am (MODULES): Add 'guix/scripts/index.scm'.
(SH_TESTS): Add 'tests/guix-index.sh'.
Signed-off-by: Ludovic Courtès <ludo@gnu.org>
---
Makefile.am | 2 +
guix/scripts/home.scm | 2 +-
guix/scripts/index.scm | 595 +++++++++++++++++++++++++++++++++++++++++++++++++
tests/guix-index.sh | 73 ++++++
4 files changed, 671 insertions(+), 1 deletion(-)
diff --git a/Makefile.am b/Makefile.am
index 23b939b674..6edd5eb900 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -302,6 +302,7 @@ MODULES = \
guix/scripts/archive.scm \
guix/scripts/import.scm \
guix/scripts/package.scm \
+ guix/scripts/index.scm \
guix/scripts/install.scm \
guix/scripts/remove.scm \
guix/scripts/upgrade.scm \
@@ -589,6 +590,7 @@ SH_TESTS = \
tests/guix-gc.sh \
tests/guix-git-authenticate.sh \
tests/guix-hash.sh \
+ tests/guix-index.sh \
tests/guix-pack.sh \
tests/guix-pack-localstatedir.sh \
tests/guix-pack-relocatable.sh \
diff --git a/guix/scripts/home.scm b/guix/scripts/home.scm
index 954bb0045f..c2da497540 100644
--- a/guix/scripts/home.scm
+++ b/guix/scripts/home.scm
@@ -67,7 +67,7 @@
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-35)
- #:use-module (srfi srfi-37)
+ #:use-module ((srfi srfi-37) #:select (option))
#:use-module (srfi srfi-71)
#:use-module (ice-9 match)
#:export (guix-home))
diff --git a/guix/scripts/index.scm b/guix/scripts/index.scm
new file mode 100644
index 0000000000..adf0f31269
--- /dev/null
+++ b/guix/scripts/index.scm
@@ -0,0 +1,595 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2022 Ludovic Courtès <ludo@gnu.org>
+;;;
+;;; 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 <http://www.gnu.org/licenses/>.
+
+(define-module (guix scripts index)
+ #:use-module ((guix i18n) #:select (G_))
+ #:use-module ((guix ui) #:select (show-version-and-exit
+ show-bug-report-information
+ with-error-handling
+ string->number*))
+ #:use-module (guix scripts)
+ #:use-module (sqlite3)
+ #:use-module (ice-9 match)
+ #:use-module (ice-9 format)
+ #:use-module (ice-9 getopt-long)
+ #: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 progress) #:select (progress-reporter/bar
+ call-with-progress-reporter))
+ #: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-37) ;; option
+ #:use-module (srfi srfi-71)
+ #:export (guix-index))
+
+(define debug #f)
+
+(define application-version 3)
+
+;; The following schema is the full schema at the `application-version`. It
+;; should be modified according to the development required and
+;; `application-version` should be bumped. If the schema needs modification
+;; across time, those should be changed directly in the full-schema and the
+;; incremental changes should be referenced as migration step below for the
+;; new `application-version` (for the existing dbs to know what to migrate).
+(define schema-full
+ "
+create table if not exists SchemaVersion (
+ version integer primary key not null,
+ date date,
+ unique (version)
+);
+
+create table if not exists Packages (
+ id integer primary key autoincrement not null,
+ name text not null,
+ version text not null,
+ output text,
+ 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);")
+
+;; List of tuple ((version . sqlite schema migration script)). There should be
+;; as much version increments as step needed to migrate the db.
+(define schema-to-migrate '((1 . "
+create table if not exists SchemaVersion (
+ version integer primary key not null,
+ unique (version)
+);
+")
+ (2 . "
+alter table SchemaVersion
+add column date date;
+")
+ (3 . "
+alter table Packages
+add column output text;
+")))
+
+(define (call-with-database file proc)
+ (let ((db (sqlite-open file)))
+ (dynamic-wind
+ (lambda () #t)
+ (lambda () (proc db))
+ (lambda () (sqlite-close db)))))
+
+(define (insert-version db version)
+ "Insert application VERSION into the DB."
+ (define stmt-insert-version
+ (sqlite-prepare db "\
+INSERT OR IGNORE INTO SchemaVersion(version, date)
+VALUES (:version, CURRENT_TIMESTAMP);"
+ #:cache? #t))
+ (sqlite-exec db "begin immediate;")
+ (sqlite-bind-arguments stmt-insert-version #:version version)
+ (sqlite-fold (const #t) #t stmt-insert-version)
+ (sqlite-exec db "commit;"))
+
+(define (read-version db)
+ "Read the current application version from the DB."
+
+ (define stmt-select-version (sqlite-prepare db "\
+SELECT version FROM SchemaVersion ORDER BY version DESC LIMIT 1;"
+ #:cache? #f))
+ (match (sqlite-fold cons '() stmt-select-version)
+ ((#(version))
+ version)))
+
+(define (insert-files db package version outputs directories)
+ "Insert DIRECTORIES files belonging to VERSION PACKAGE (with OUTPUTS)."
+ (define stmt-select-package
+ (sqlite-prepare db "\
+SELECT id FROM Packages WHERE name = :name AND version = :version LIMIT 1;"
+ #:cache? #t))
+
+ (define stmt-insert-package
+ (sqlite-prepare db "\
+INSERT OR REPLACE INTO Packages(name, version, output)
+VALUES (:name, :version, :output);"
+ #: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;")
+ ;; 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)))
+ outputs)
+ (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;"))
+
+
+;;;
+;;; Indexing from local packages.
+;;;
+
+(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 (insert-packages-with-progress db packages insert-package-fn)
+ "Insert PACKAGES into DB with progress bar report."
+ (let* ((nb-packages (length packages))
+ (prefix (format #f "Registering ~a packages" nb-packages))
+ (progress (progress-reporter/bar nb-packages prefix)))
+ (call-with-progress-reporter progress
+ (lambda (report)
+ (for-each (lambda (package)
+ (insert-package-fn db package)
+ (report))
+ packages)))))
+
+
+;;;
+;;; Indexing from local profiles.
+;;;
+
+(define (all-profiles)
+ "Return the list of system profiles."
+ (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 deduplicated manifest entries across all PROFILES."
+ (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 a manifest ENTRY into DB."
+ (insert-files db (manifest-entry-name entry)
+ (manifest-entry-version entry)
+ (list (manifest-entry-output entry))
+ (list (manifest-entry-item entry)))) ;FIXME: outputs?
+
+(define (index-packages-from-manifests-with-db db-pathname)
+ "Index packages entries into DB-PATHNAME from the system manifests."
+ (call-with-database db-pathname
+ (lambda (db)
+ (let ((entries (profiles->manifest-entries (all-profiles))))
+ (insert-packages-with-progress db entries insert-manifest-entry)))))
+
+
+;;;
+;;; Search.
+;;;
+
+(define-record-type <package-match>
+ (package-match name version output file)
+ package-match?
+ (name package-match-name)
+ (version package-match-version)
+ (output package-match-output)
+ (file package-match-file))
+
+(define (matching-packages db file)
+ "Return unique <package-match> corresponding to packages containing FILE."
+ (define lookup-stmt
+ (sqlite-prepare db "\
+SELECT p.name, p.version, p.output, d.name, f.name
+FROM Packages p
+INNER JOIN Files f, Directories d
+ON f.basename = :file
+ AND d.id = f.directory
+ AND p.id = d.package;"))
+
+ (sqlite-bind-arguments lookup-stmt #:file file)
+ (sqlite-fold (lambda (result lst)
+ (match result
+ (#(package version output directory file)
+ (cons (package-match package version output
+ (string-append directory "/" file))
+ lst))))
+ '() lookup-stmt))
+
+
+
+;;;
+;;; CLI
+;;;
+
+(define (index-packages-from-store-with-db db-pathname)
+ "Index local store packages using db at location DB-PATHNAME."
+ (call-with-database db-pathname
+ (lambda (db)
+ (with-store store
+ (parameterize ((%graft? #f))
+ (define (insert-package-from-store db package)
+ (run-with-store store (insert-package db package)))
+ (let ((packages (fold-packages
+ cons
+ '()
+ #:select? (lambda (package)
+ (and (not (hidden-package? package))
+ (not (package-superseded package))
+ (supported-package? package))))))
+ (insert-packages-with-progress
+ db packages insert-package-from-store)))))))
+
+(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 (read-version-from-db db-pathname)
+ (call-with-database db-pathname
+ (lambda (db) (read-version db))))
+
+(define (migrate-schema-to-version db-pathname)
+ (call-with-database db-pathname
+ (lambda (db)
+ (catch #t
+ (lambda ()
+ ;; Migrate from the current version to the full migrated schema
+ ;; This can raise sqlite-error if the db is not properly configured
yet
+ (let* ((current-db-version (read-version db))
+ (next-db-version (+ 1 current-db-version)))
+ (when (< current-db-version application-version)
+ ;; when the current db version is older than the current
application
+ (let ((schema-migration-at-version (assoc-ref schema-to-migrate
next-db-version)))
+ (when schema-migration-at-version
+ ;; migrate the schema to the next version (if it exists)
+ (sqlite-exec db schema-migration-at-version)
+ ;; insert current version
+ (insert-version db next-db-version)
+ ;; iterate over the next migration if any
+ (migrate-schema-to-version db))))))
+ (lambda (key . arg)
+ ;; exception handler in case failure to read an inexisting db
+ ;; Fallback to boostrap the schema
+ (sqlite-exec db schema-full)
+ (insert-version db application-version))))))
+
+(define (print-matching-results matches)
+ "Print the MATCHES matching results."
+ (for-each (lambda (result)
+ (let ((name (package-match-name result))
+ (version (package-match-version result))
+ (output (package-match-output result))
+ (file (package-match-file result)))
+ (format #t "~20a ~a~%"
+ (string-append name "@" version
+ (if (string-null? output)
+ ""
+ (string-append ":" output)))
+ file)))
+ 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 argument, indexes (package, file) relationships from the machine.
+This allows indexation with 2 methods, out of the local:
+
+- manifests: This is the fastest implementation with the caveat of indexing
+less packages. That'd be typically the use case of user local indexation.
+
+- store: This is slowest implementation. It discusses with the store
+daemon. That'd be typically the use case of building the largest db in one of
+the build farm node.
+
+With 'search FILE', search for packages installing FILE.\n
+Note: Internal cache is located at ~/.cache/guix/index/db.sqlite by default.
+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)
+ (display (G_ "
+ --method=METH Change default indexation method. By default it uses the
+ local \"manifests\" (faster). It can also uses the local
+ \"store\" (slower, typically on the farm build ci)."))
+ (newline)
+ (display (G_ "The valid values for ARGS are:"))
+ (newline)
+ (display (G_ "
+ search FILE Search for packages installing the FILE (from cache db)"))
+ (newline)
+ (display (G_ "
+ <EMPTY> Without any argument, it index packages. This fills in the
+ db cache using whatever indexation method is defined."))
+ (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)
+ (catch 'sqlite-error
+ (lambda ()
+ (let ((db-path (assoc-ref result 'db-path)))
+ (simple-format
+ #t
+ "Extension local cache database:\n- path: ~a\n- version:
~a\n\n"
+ db-path (read-version-from-db db-path))))
+ (lambda (key . arg) 'no-db-yet-so-nothing-to-display))
+ (show-version-and-exit "guix index")))
+ ;; index data out of the method (store or package)
+ (option '(#\d "db-path") #f #t
+ (lambda (opt name arg result)
+ (when debug
+ (format #t "%options: --db-path: opt ~a\n" opt)
+ (format #t "%options: --db-path: name ~a\n" name)
+ (format #t "%options: --db-path: arg ~a\n" arg)
+ (format #t "%options: --db-path: result ~a\n" result))
+ (alist-cons 'db-path arg
+ (alist-delete 'db-path result))))
+
+ ;; index data out of the method (store or package)
+ (option '(#\m "method") #f #t
+ (lambda (opt name arg result)
+ (when debug
+ (format #t "%options: --method: opt ~a\n" opt)
+ (format #t "%options: --method: name ~a\n" name)
+ (format #t "%options: --method: arg ~a\n" arg)
+ (format #t "%options: --method: result ~a\n" result))
+ (match arg
+ ((or "manifests" "store")
+ (alist-cons 'with-method arg
+ (alist-delete 'with-method result)))
+ (_
+ (G_ "guix index: Wrong indexation method, either manifests
+ (fast) or store (slow)~%")))))))
+
+(define %default-options
+ `((db-path . ,default-db-path)
+ (with-method . "manifests")))
+
+(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.
+ (when debug
+ (format #t "parse-sub-command: arg: ~a\n" arg)
+ (format #t "parse-sub-command: result: ~a\n" result)
+ (format #t "parse-sub-command: (assoc-ref result 'action): ~a\n"
(assoc-ref result 'action))
+ (format #t "parse-sub-command: (assoc-ref result 'argument): ~a\n"
(assoc-ref result 'argument)))
+ (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)))
+
+ (when debug
+ (format #t "option-arguments: args: ~a\n" args)
+ (format #t "option-arguments: count: ~a\n" count)
+ (format #t "option-arguments: action: ~a\n" action))
+
+ (define (fail)
+ (leave (G_ "wrong number of arguments for action '~a'~%")
+ action))
+
+ (unless action
+ (format (current-error-port)
+ (G_ "guix index: missing command name~%"))
+ (format (current-error-port)
+ (G_ "Try 'guix index --help' for more information.~%"))
+ (exit 1))
+ (alist-cons 'argument (string-concatenate args)
+ (alist-delete 'argument
+ (alist-cons 'action action
+ (alist-delete 'action opts))))))
+
+ (with-error-handling
+ (let* ((opts (parse-command-line args %options
+ (list %default-options)
+ ;; ignore $GUIX_BUILD_OPTIONS
+ ;; otherwise, subcommand is not
+ ;; detected in the tests context
+ #:build-options? #f
+ #:argument-handler
+ parse-sub-command))
+ (args (option-arguments opts))
+ (action (assoc-ref args 'action))
+ (db-path (assoc-ref args 'db-path))
+ (with-method (assoc-ref args 'with-method)))
+ (when debug
+ (format #t "main: opts: ~a\n" opts)
+ (format #t "main: args: ~a\n" args)
+ (format #t "main: action: ~a\n" action)
+ (format #t "main: db-path: ~a\n" db-path)
+ (format #t "main: with-method: ~a\n" with-method))
+
+ (match action
+ ('search
+ (unless (file-exists? db-path)
+ (format (current-error-port)
+ (G_ "guix index: The local cache db does not exist yet.
+You need to index packages first.\nTry 'guix index --help' for more
information.~%"))
+ (exit 1))
+ (let* ((file (assoc-ref args 'argument))
+ (matches (matching-packages-with-db db-path file)))
+ (print-matching-results matches)
+ (exit (pair? matches))))
+ ('index
+ (let ((db-dirpath (dirname db-path)))
+ (unless (file-exists? db-dirpath)
+ (mkdir db-dirpath)))
+ ;; Migrate/initialize db to schema at version application-version
+ (migrate-schema-to-version db-path)
+ ;; Finally index packages
+ (if (string= with-method "manifests")
+ (index-packages-from-manifests-with-db db-path)
+ (index-packages-from-store-with-db db-path)))))))
diff --git a/tests/guix-index.sh b/tests/guix-index.sh
new file mode 100755
index 0000000000..2c21d45a6b
--- /dev/null
+++ b/tests/guix-index.sh
@@ -0,0 +1,73 @@
+# GNU Guix --- Functional package management for GNU
+# Copyright © 2013, 2014, 2015, 2019, 2020, 2023 Ludovic Courtès <ludo@gnu.org>
+#
+# 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 <http://www.gnu.org/licenses/>.
+
+#
+# Test the 'guix index' command-line utility.
+#
+
+set -x
+
+tmpdir="guix-index-$$"
+trap 'rm -rf "$tmpdir"' EXIT
+
+guix index --version
+
+# Basic application to install and lookup through the index subcommand
+APPLICATION=guile-bootstrap
+
+# The subcommand exposes two indexation methods so far:
+# - manifests: fast and less exhaustive
+# - store: slow, exhaustive
+
+# In the following tests, we will store in 2 different dbs for both indexation
+# methods
+tmpdb_manifests="$tmpdir/manifests/db.sqlite"
+tmpdb_store="$tmpdir/store/db.sqlite"
+
+echo "### Preparing db locations for both indexation methods"
+mkdir -p `dirname $tmpdb_manifests` `dirname $tmpdb_store`
+
+cmd_manifests="guix index --db-path=$tmpdb_manifests --method=manifests"
+cmd_store="guix index --db-path=$tmpdb_store --method=store"
+
+echo "### Lookup without any db should fail"
+! $cmd_manifests search "$APPLICATION"
+! $cmd_store search "$APPLICATION"
+
+echo "### Initializing db with bare guix store should work"
+$cmd_manifests
+# ! $cmd_store
+
+echo "### lookup without anything in db should yield no result"
+! test `$cmd_manifests search "$APPLICATION"`
+# ! test `$cmd_store search "$APPLICATION"`
+
+echo "### Add some package to the temporary store"
+guix package --bootstrap \
+ --install $APPLICATION \
+ --profile=$tmpdir/profile
+
+echo "### Both both indexation call should work"
+# Testing indexation should work for both method
+test `$cmd_manifests`
+# test `$cmd_store`
+
+echo "### lookup indexed '$APPLICATION' should yield result"
+
+test `$cmd_manifests search "$APPLICATION"`
+# test `$cmd_store search "$APPLICATION"`
- branch wip-guix-index created (now aa6831cc4f), guix-commits, 2023/04/02
- 02/07: DRAFT Add 'guix index'.,
guix-commits <=
- 04/07: squash! "--db-path" -> "--database"., guix-commits, 2023/04/02
- 03/07: squash! Update test., guix-commits, 2023/04/02
- 06/07: squash! "with-method" -> "method", guix-commits, 2023/04/02
- 05/07: squash! Improve error reporting and i18n., guix-commits, 2023/04/02
- 07/07: squash! Don't insert directory if it's already present., guix-commits, 2023/04/02
- 01/07: store: Tolerate non-existent GC root directories., guix-commits, 2023/04/02