Add the ability to use sqlite's FTS to query text contents, set version to 0.5.0

.elpaignore

@@ -1,2 +1,2 @@
-*-test.el
+*-test*.el
 Eldev

NEWS.org

@@ -1,5 +1,8 @@
 TITLE: Changelog for the triples module for GNU Emacs.
 
+* 0.5.0
+- Add FTS for adding full text search.
+- Fix for emacsql using an obsolete (or wrong) db opening function.
 * 0.4.1
 - Remove test files from GNU ELPA package.
 * 0.4.0

README.org

@@ -105,6 +105,28 @@ Sometimes clients of this library need to do something with the database, and th
 - =triples-db-select=: Select triples matching any of the parts of the triple.  Like =triples-db-delete=, empty arguments match everything.  You can specify exactly what to return with a selector.
 
 Sometimes this still doesn't cover what you might want to do.  In that case, you should write your own direct database access.  However, please follow the coding patterns for the functions above in writing it, so that the code works with both Emacs 29's builtin sqlite, and =emacsql=.
+** Search
+Triples supports [[https://www.sqlite.org/fts5.html][SQLite's FTS5 extension]], which lets you run full text searches with scored results over text objects in the triples database.  This will create new FTS tables to store the data necessary for the search.  It is only available using the built-in sqlite in Emacs 29.1 and later.  To enable:
+
+#+begin_src emacs-lisp
+(require 'triples-fts)
+(triples-fts-setup db)
+
+;; If you need to rebuild the index
+(triples-fts-rebuild db)
+
+;; Find the subjects for all objects that contain "panda", ordering by most
+;; relevant to least.
+(triples-fts-query-subject db "panda")
+
+;; Find the subjects for all objects with the predicate `description/text' (type
+;; description, property text) that contain the word "panda", ordering by most
+;; relevant to least.
+(triples-fts-query-subject db "description/text:panda")
+
+;; The same, but with substitution with an abbreviation.
+(triples-fts-query-subject db "desc:panda" '(("desc" . "description/text")))
+#+end_src
 ** Backups
 If your application wants to back up your database, the function =triples-backup= provides the capability to do so safely.  It can be called like:
 #+begin_src emacs-lisp

triples-fts-test.el

@@ -0,0 +1,67 @@
+;;; triples-fts-test.el --- Tests for triples FTS module.  -*- lexical-binding: t; -*-
+
+;; Copyright (c) 2025  Free Software Foundation, Inc.
+
+;; This program 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 2 of the
+;; License, or (at your option) any later version.
+;;
+;; This program 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 Emacs.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This file contains tests for the triples FTS module.
+
+;;; Code:
+
+(require 'ert)
+(require 'triples-test-utils)
+(require 'triples-fts)
+
+(ert-deftest triples-fts-query-subject-after-setup ()
+  (triples-test-with-temp-db
+    (triples-fts-setup db)
+    (triples-add-schema db 'text '(text :base/type string :base/unique t)
+                        '(moretext :base/type string :base/unique t))
+    (triples-set-subject db 'a '(text :text "Hello, world!" :moretext "World is bond"))
+    (triples-set-subject db 'b '(text :text "Goodbye, world!"))
+    (should (equal '(a b)
+                   (triples-fts-query-subject db "world")))
+    (should (equal '(a)
+                   (triples-fts-query-subject db "bond")))))
+
+(ert-deftest triples-fts-query-subject-added-before-setup ()
+  (triples-test-with-temp-db
+    (triples-add-schema db 'text '(text :base/type string :base/unique t)
+                        '(moretext :base/type string :base/unique t))
+    (triples-set-subject db 'a '(text :text "Hello, world!" :moretext "World is bond"))
+    (triples-set-subject db 'b '(text :text "Goodbye, world!"))
+    (triples-fts-setup db)
+    (should (equal '(a b)
+                   (triples-fts-query-subject db "world")))
+    (should (equal '(a)
+                   (triples-fts-query-subject db "bond")))))
+
+(ert-deftest triples-fts-query-subject-with-abbrev ()
+  (triples-test-with-temp-db
+    (let ((abbrevs '(("tag" . "text/tag"))))
+      (triples-fts-setup db)
+      (triples-add-schema db 'text '(text :base/type string :base/unique t)
+                          '(tag :base/type string))
+      (triples-set-subject db 'a '(text :text "Hello, world!" :tag ("foo" "bar")))
+      (should (equal '(a) (triples-fts-query-subject db "Hello" abbrevs)))
+      (should (equal '(a) (triples-fts-query-subject db "tag:foo world" abbrevs)))
+      (should (equal '(a) (triples-fts-query-subject db "tag: foo world" abbrevs)))
+      (should (equal nil (triples-fts-query-subject db "tag:baz world" abbrevs)))
+      (should (equal '(a) (triples-fts-query-subject db "text/tag:foo world" abbrevs))))))
+
+(provide 'triples-fts-test)
+
+;;; triples-fts-test.el ends here

triples-fts.el

@@ -0,0 +1,142 @@
+;;; triples-fts.el --- Sqlite full text search for triples. -*- lexical-binding: t; -*-
+
+;; Copyright (c) 2023  Free Software Foundation, Inc.
+
+;; Author: Andrew Hyatt <ahyatt@gmail.com>
+;; Homepage: https://github.com/ahyatt/triples
+;;
+;; This program 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 2 of the
+;; License, or (at your option) any later version.
+;;
+;; This program 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 Emacs.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;; This package provides full text search for triples.  It uses sqlite's FTS
+;; capabilities.  It indexes all text objects.
+
+;; This only will work with the built-in sqlite support in Emacs 29.1 or later.
+
+;;; Code:
+
+(require 'triples)
+(require 'sqlite)
+(require 'seq)
+
+(defun triples-fts-setup (db &optional force)
+  "Ensure DB has a FTS table.
+As long as the FTS table exists, this will not try to recreate
+it.  If FORCE is non-nil, then the FTS and all triggers will be
+recreated and repopulated."
+  (unless (eq triples-sqlite-interface 'builtin)
+    (error "Emacs 29.1 or later is required for triples-fts"))
+  (let ((fts-existed (sqlite-select db "SELECT name FROM sqlite_master WHERE type='table' AND name='triples_fts'")))
+    (when force (sqlite-execute db "DROP TABLE triples_fts"))
+    (sqlite-execute db "CREATE VIRTUAL TABLE IF NOT EXISTS triples_fts USING fts5 (subject, predicate, object, content=triples, content_rowid=rowid)")
+    ;; Triggers that will update triples_fts, but only for text objects.
+    ;; New rows:
+    (when force (sqlite-execute db "DROP TRIGGER IF EXISTS triples_fts_insert"))
+    (sqlite-execute db "CREATE TRIGGER IF NOT EXISTS triples_fts_insert AFTER INSERT ON triples
+      WHEN new.object IS NOT NULL and typeof(new.object) = 'text'
+      BEGIN
+        INSERT INTO triples_fts (rowid, subject, predicate, object) VALUES (new.rowid, new.subject, new.predicate, new.object);
+      END")
+    ;; Updated rows:
+    (when force (sqlite-execute db "DROP TRIGGER IF EXISTS triples_fts_update"))
+    (sqlite-execute db "CREATE TRIGGER IF NOT EXISTS triples_fts_update AFTER UPDATE ON triples
+        WHEN new.object IS NOT NULL AND typeof(new.object) = 'text'
+        BEGIN
+          INSERT INTO triples_fts (triples_fts, rowid, subject, predicate, object) VALUES ('delete', old.rowid, old.subject, old.predicate, old.object);
+          INSERT INTO triples_fts (rowid, subject, predicate, object) VALUES (new.rowid, new.subject, new.predicate, new.object);
+        END")
+    ;; Deleted rows:
+    (when force (sqlite-execute db "DROP TRIGGER IF EXISTS triples_fts_delete"))
+    (sqlite-execute db "CREATE TRIGGER IF NOT EXISTS triples_fts_delete AFTER DELETE ON triples
+      WHEN old.object IS NOT NULL AND typeof(old.object) = 'text'
+      BEGIN
+        INSERT INTO triples_fts (triples_fts, subject, predicate, object) VALUES ('delete', old.subject, old.predicate, old.object);
+      END")
+    (if (or force (not fts-existed)) (triples-fts-rebuild db))))
+
+(defun triples-fts-rebuild (db)
+  "Rebuild the FTS table for DB."
+  (sqlite-execute db "INSERT INTO triples_fts (triples_fts) VALUES ('rebuild')"))
+
+(defun triples-fts--split-query (query)
+  "Return the QUERY split by whitespace, except for quoted strings."
+  ;; First, we remove all quoted strings via regexes.
+  (let ((quoted-strings '())
+        (quoted-strings-re (rx (seq "\"" (group (zero-or-more (not (any "\"")))) "\"")))
+        (query-copy (replace-regexp-in-string (rx (seq ?: (zero-or-more space))) ":" query)))
+    (while (string-match quoted-strings-re query-copy)
+      (push (match-string 1 query-copy) quoted-strings)
+      (setq query-copy (replace-match "" t t query-copy)))
+    ;; Now we split by whitespace, except for quoted strings.
+    (append (split-string query-copy) quoted-strings)))
+
+(defun triples-fts--transform-query (query abbrevs)
+  "Rewrite abbreviations in QUERY based on `triples-fts-predicate-abbrevs`.
+
+This returns a list of new queries.  Because each triple is a row, we
+have each part of the query matching separately, and then we do an
+intersection on the results.
+
+Because predicates that we need to match against are
+
+E.g. if `tag' is an abbreviation for `tagged/tag', from the alist
+ABBREVS, then: \"tag:foo urgent\" ==> \"predicate:\"tagged/tag\"
+object:\"foo\" urgent\"."
+  ;; Split by whitespace, except for quoted strings.
+  (let ((segments (triples-fts--split-query query)))
+    (mapcar
+     (lambda (w)
+       (if (string-match "^\\([^:]+\\):\\(.*\\)$" w)
+           (let* ((prefix (match-string 1 w))
+                  (rest   (match-string 2 w))
+                  (full   (assoc-default prefix abbrevs)))
+             (if (or full (string-match-p "/" prefix))
+                 ;; Example: "tag" => "tagged/tag", rest => "foo"
+                 (format "predicate:\"%s\" object:\"%s\"" (or full prefix) rest)
+               w))  ; No known abbreviation; just leave as-is.
+         w))
+     segments)))
+
+(defun triples-fts-query-subject (db query &optional abbrevs)
+  "Query DB with QUERY, returning only subjects.
+
+QUERY should not have operators such as AND or OR, everything is assumed
+to be ANDed together.  Phrases can be in quotes.
+
+Predicates can appear before colons to restrict a query term.  For
+example, `person/name:Billy'.  Anything with a slash in it, or matching
+an entry in ABBREV will be used to filter by a predicate, otherwise it
+is passed to FTS5 as-is.
+
+ABBREVS is an alist of abbreviations to predicate (both strings).  If
+this is populated then we also expand user abbreviations like `tag:xyz`
+=> `predicate:\"tagged/tag\" object:\"xyz\"`."
+  (seq-uniq
+   (mapcar
+    #'triples-standardize-result
+    (cl-reduce #'seq-intersection
+               (mapcar
+                (lambda (subquery)
+                  (mapcar #'car
+                          (sqlite-select
+                           db
+                           "SELECT subject FROM triples_fts
+         WHERE triples_fts MATCH ?
+         ORDER BY rank"
+                           (list subquery))))
+                (triples-fts--transform-query query abbrevs))))))
+
+(provide 'triples-fts)
+
+;;; triples-fts.el ends here

triples-test-utils.el

@@ -0,0 +1,65 @@
+;;; triples-test-utils.el --- Test utilities for triples.el -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2023-2025 Free Software Foundation, Inc.
+
+;; This program 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 2 of the
+;; License, or (at your option) any later version.
+;;
+;; This program 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 Emacs.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Thyis file contiains utilities for testing triples.el, all with the
+;; `triples-test' prefix.
+
+;;; Code:
+
+(defvar triples-test-db-file nil
+  "The database file used in a test.
+This is defined so we can easily debug into it.")
+
+(defmacro triples-test-with-temp-db (&rest body)
+  "Run BODY with a temporary database file."
+  (declare (indent 0) (debug t))
+  `(let ((db-file (make-temp-file "triples-test")))
+     (unwind-protect
+         (progn
+           (let ((db (triples-connect db-file)))
+             (setq triples-test-db-file db-file)
+             ,@body
+             (triples-close db)))
+       (delete-file db-file))))
+
+(defun triples-test-open-db ()
+  "Open the database file used in the current test.
+This is useful when debugging a test."
+  (interactive)
+  (sqlite-mode-open-file triples-test-db-file))
+
+(defmacro triples-deftest (name _ &rest body)
+  "Create a test exercising variants of `triples-sqlite-interface'.
+NAME is the name of the test, and BODY is the test code."
+  (declare (debug t) (indent 2))
+  (let ((builtin-name (intern (format "%s-builtin" name)))
+        (emacsql-name (intern (format "%s-emacsql" name))))
+    `(progn
+       (ert-deftest ,builtin-name ()
+         (let ((triples-sqlite-interface 'builtin))
+           (skip-unless (and (fboundp 'sqlite-available-p) (sqlite-available-p)))
+           ,@body))
+       (ert-deftest ,emacsql-name ()
+         (let ((triples-sqlite-interface 'emacsql))
+           (skip-unless (featurep 'emacsql))
+           ,@body)))))
+
+(provide 'triples-test-utils)
+
+;;; triples-test-utils.el ends here

triples-test.el

@@ -26,47 +26,14 @@
 ;;; Code:
 
 (require 'triples)
+(require 'triples-test-utils)
 (require 'seq)
 (require 'kv)
 (require 'emacsql nil t)                ;; May be absent.
 (require 'emacsql-sqlite nil t)         ;; May be absent.
 
 ;;; Code:
 
-(defvar triples-test-db-file nil
-  "The database file used in a test. This is defined so we can
-easily debug into it.")
-
-(defmacro triples-test-with-temp-db (&rest body)
-  (declare (indent 0) (debug t))
-  `(let ((db-file (make-temp-file "triples-test")))
-     (unwind-protect
-         (progn
-           (let ((db (triples-connect db-file)))
-             (setq triples-test-db-file db-file)
-             ,@body
-             (triples-close db)))
-       (delete-file db-file))))
-
-(defun triples-test-open-db ()
-  (interactive)
-  (sqlite-mode-open-file triples-test-db-file))
-
-(defmacro triples-deftest (name _ &rest body)
-  "Create a test exercising variants of `triples-sqlite-interface'."
-  (declare (debug t) (indent 2))
-  (let ((builtin-name (intern (format "%s-builtin" name)))
-        (emacsql-name (intern (format "%s-emacsql" name))))
-    `(progn
-       (ert-deftest ,builtin-name ()
-         (let ((triples-sqlite-interface 'builtin))
-           (skip-unless (and (fboundp 'sqlite-available-p) (sqlite-available-p)))
-           ,@body))
-       (ert-deftest ,emacsql-name ()
-         (let ((triples-sqlite-interface 'emacsql))
-           (skip-unless (featurep 'emacsql))
-           ,@body)))))
-
 (triples-deftest triples-connect-default ()
   (let* ((triples-default-database-filename (make-temp-file "triples-default"))
          (db (triples-connect)))