branch: externals/triples
commit d82cc1d6b8c2cc439dce20cf3399f96e27d0701a
Author: Andrew Hyatt <ahy...@gmail.com>
Commit: Andrew Hyatt <ahy...@gmail.com>
Finish basic sqlite layer, and fix everything so tests work.
Also, finish testing for the basic sqlite layer.
---
triples-test.el | 101 ++++++++++++++++++++++++++++---
triples.el | 184 ++++++++++++++++++++++++++++++++++++++------------------
2 files changed, 217 insertions(+), 68 deletions(-)
diff --git a/triples-test.el b/triples-test.el
index 2844dccf96..2c9afe098d 100644
--- a/triples-test.el
+++ b/triples-test.el
@@ -26,6 +26,87 @@ easily debug into it.")
(let ((sql-database triples-test-db-file))
(sql-sqlite (format "*schema test db SQL %s*" triples-test-db-file))))
+(ert-deftest triples-test-insert ()
+ (triples-test-with-temp-db
+ (triples--insert db "sub" 'pred "obj")
+ ;; Test for emacsql compability
+ (should (equal (sqlite-select db "SELECT * FROM triples")
+ '(("\"sub\"" "pred" "\"obj\"" "()"))))
+ ;; Test that it replaces - this shouldn't result in two rows.
+ (triples--insert db "sub" 'pred "obj")
+ (should (equal (sqlite-select db "SELECT count(*) FROM triples")
+ '((1))))
+ ;; Test that colons in the predicate are stripped away when stored.
+ (triples--insert db "sub" :test/pred "obj")
+ (should (equal (sqlite-select db "SELECT count(*) FROM triples WHERE
predicate = ?"
+ '("test/pred"))
+ '((1))))
+ ;; Test we correctly test for bad inputs.
+ (should-error (triples--insert db "sub" "pred" "obj"))
+ (should-error (triples--insert db "sub" 'pred "obj" '(ordinary-list)))
+ (should-error (triples--insert db "sub" 'pred "obj" "string"))
+ ;; Test that we can have symbol subject and objects
+ (triples--insert db 'sub 'pred 'obj)
+ (should (equal (sqlite-select db "SELECT * FROM triples WHERE subject = ?"
'("sub"))
+ '(("sub" "pred" "obj" "()"))))))
+
+(ert-deftest triples-test-delete ()
+ (triples-test-with-temp-db
+ (triples--insert db 1 'pred 2)
+ (triples--insert db 2 'pred 1)
+ (triples--delete db 1)
+ (should (equal (sqlite-select db "SELECT count(*) FROM triples")
+ '((1))))
+ (should (equal (sqlite-select db "SELECT count(*) FROM triples WHERE
subject = ?" '(1))
+ '((0))))
+ (triples--insert db 1 'pred 2)
+ (triples--delete db nil nil 2)
+ (should (equal (sqlite-select db "SELECT count(*) FROM triples WHERE
object = ?" '(2))
+ '((0))))
+ (triples--insert db 1 'pred 2)
+ (triples--delete db nil 'pred nil)
+ (should (equal (sqlite-select db "SELECT count(*) FROM triples")
+ '((0))))))
+
+(ert-deftest triples-test-delete-subject-predicate-prefix ()
+ (triples-test-with-temp-db
+ (triples--insert db 1 'test/foo 2)
+ (triples--insert db 1 'bar/bar 1)
+ (triples--delete-subject-predicate-prefix db 1 'test)
+ (should (equal (sqlite-select db "SELECT count(*) FROM triples")
+ '((1))))
+ ;; Make sure colons are stripped.
+ (triples--delete-subject-predicate-prefix db 1 :bar)
+ (should (equal (sqlite-select db "SELECT count(*) FROM triples")
+ '((0))))))
+
+(ert-deftest triples-test-select ()
+ (triples-test-with-temp-db
+ (triples--insert db 1 'pred 2 '(:a 1))
+ (let ((expected '((1 pred 2 (:a 1)))))
+ (should (equal (triples--select db 1) expected))
+ (should (equal (triples--select db nil 'pred) expected))
+ (should (equal (triples--select db nil nil 2) expected))
+ (should (equal (triples--select db 1 nil 2) expected))
+ (should (equal (triples--select db 1 'pred 2) expected))
+ (should (equal '((1)) (triples--select db 1 nil nil nil '(subject))))
+ (should (equal '((1 pred)) (triples--select db 1 nil nil nil '(subject
predicate)))))))
+
+(ert-deftest triples-test-select-with-pred-prefix ()
+ (triples-test-with-temp-db
+ (triples--insert db 'sub1 'pred/foo 'obj)
+ (triples--insert db 'sub1 'pred/bar 'obj)
+ (triples--insert db 'sub2 'pred/foo 'obj)
+ (should (equal (triples-test-list-sort (triples--select-pred-prefix db
'sub1 'pred))
+ (triples-test-list-sort '((sub1 pred/foo obj nil)
+ (sub1 pred/bar obj nil)))))))
+
+(ert-deftest triples-test-select-predicate-object-fragment ()
+ (triples-test-with-temp-db
+ (triples--insert db 'sub1 'pred/foo "a whole phrase")
+ (should (equal (triples--select-predicate-object-fragment db 'pred/foo
"whole")
+ '((sub1 pred/foo "a whole phrase" nil))))))
+
(defun triples-test-op-equals (result target)
(and (equal (car result) (car target))
(seq-set-equal-p (cdr result) (cdr target) #'equal)))
@@ -164,15 +245,15 @@ easily debug into it.")
(ert-deftest triples-with-predicate ()
(triples-test-with-temp-db
(triples-add-schema db 'named '(name))
- (should-not (triples-with-predicate db :named/name))
+ (should-not (triples-with-predicate db 'named/name))
(triples-set-type db "foo" 'named :name "My Name Is Fred Foo")
(triples-set-type db "bar" 'named :name "My Name Is Betty Bar")
(should (equal
- '(("bar" named/name "My Name Is Betty Bar" (:empty t))
- ("foo" named/name "My Name Is Fred Foo" (:empty t)))
- (sort (triples-with-predicate db :named/name)
- (lambda (a b)
- (string< (car a) (car b))))))))
+ (triples-test-list-sort
+ '(("bar" named/name "My Name Is Betty Bar" nil)
+ ("foo" named/name "My Name Is Fred Foo" nil)))
+ (triples-test-list-sort
+ (triples-with-predicate db 'named/name))))))
(ert-deftest triples-subjects-of-type ()
(triples-test-with-temp-db
@@ -189,12 +270,12 @@ easily debug into it.")
(triples-add-schema db 'marker)
(triples-set-type db "foo" 'marker)
(should (equal '((1))
- (sqlite-select db "COUNT(*) FROM triples WHERE subject = ?
AND predicate = 'base/type' AND object = 'marker'"
- (triples-standardize-val "foo"))))
+ (sqlite-select db "SELECT COUNT(*) FROM triples WHERE
subject = ? AND predicate = 'base/type' AND object = 'marker'"
+ (list (triples-standardize-val "foo")))))
(triples-set-type db "foo" 'marker)
(should (equal '((1))
- (sqlite-select db "COUNT(*) FROM triples WHERE subject = ?
AND predicate = 'base/type' AND object = 'marker'"
- (triples-standardize-val "foo"))))))
+ (sqlite-select db "SELECT COUNT(*) FROM triples WHERE
subject = ? AND predicate = 'base/type' AND object = 'marker'"
+ (list (triples-standardize-val "foo")))))))
(ert-deftest triples-readme ()
(triples-test-with-temp-db
diff --git a/triples.el b/triples.el
index bf9403d9ea..37c51e7e3c 100644
--- a/triples.el
+++ b/triples.el
@@ -28,32 +28,24 @@
(require 'cl-macs)
(require 'seq)
+(require 'subr-x)
;;; Code:
(defun triples-connect (file)
"Connect to the database FILE and make sure it is populated."
(let* ((db (sqlite-open file)))
- (sqlite-execute db "CREATE TABLE IF NOT EXISTS triples(subject TEXT NOT
NULL, predicate TEXT NOT NULL, object TEXT, PROPERTIES TEXT NOT NULL)")
+ (sqlite-execute db "CREATE TABLE IF NOT EXISTS triples(subject TEXT NOT
NULL, predicate TEXT NOT NULL, object TEXT, properties TEXT NOT NULL)")
(sqlite-execute db "CREATE INDEX IF NOT EXISTS subject_idx ON triples
(subject)")
(sqlite-execute db "CREATE INDEX IF NOT EXISTS subject_predicate_idx ON
triples (subject, predicate)")
(sqlite-execute db "CREATE INDEX IF NOT EXISTS predicate_object_idx ON
triples (predicate, object)")
- (sqlite-execute db "CREATE INDEX IF NOT EXISTS
subject_predicate_object_properties_idx ON triples (subject, predicate, object,
properties)")
+ (sqlite-execute db "CREATE UNIQUE INDEX IF NOT EXISTS
subject_predicate_object_properties_idx ON triples (subject, predicate, object,
properties)")
db))
(defun triples-close (db)
"Close sqlite database DB."
(sqlite-close db))
-(defun triples--ensure-property-val (vec)
- "Return a VEC has 4 elements.
-We add a bogus value as a property because we want to be able
-to enforce unique constraints, which sqlite will not do will NULL
-values."
- (if (= (length vec) 4)
- vec
- (vconcat vec '((:empty t)))))
-
(defun triples--subjects (triples)
"Return all unique subjects in TRIPLES."
(seq-uniq (mapcar #'car triples)))
@@ -79,10 +71,108 @@ values."
(defun triples-standardize-val (val)
"If VAL is a string, return it as enclosed in quotes
This is done to have compatibility with the way emacsql stores
-values."
- (if (stringp val)
- (format "\"%s\"" val)
- val))
+values. Turn a symbol into a string as well, but not a quoted
+one, because sqlite cannot handle symbols."
+ (if val
+ (pcase (type-of val)
+ ('string (format "\"%s\"" val))
+ ('symbol (format "%s" val))
+ ('cons (format "%s" val))
+ (_ val))
+ ;; Just to save a bit of space, let's use "()" instead of "null", which is
+ ;; what it would be turned into by the pcase above.
+ "()"))
+
+(defun triples-standardize-result (result)
+ "Return RESULT in standardized form.
+This imitates the way emacsql returns items, with strings
+becoming either symbols, lists, or strings depending on whether
+the string itself is wrapped in quotes."
+ (if (and (string-prefix-p "\"" result)
+ (string-suffix-p "\"" result))
+ (string-remove-suffix "\"" (string-remove-prefix "\"" result))
+ (read result)))
+
+(defun triples--insert (db subject predicate object &optional properties)
+ "Insert triple to DB: SUBJECT, PREDICATE, OBJECT with PROPERTIES.
+This is a SQL replace operation, because we don't want any
+duplicates; if the triple is the same, it has to differ at least
+with PROPERTIES. This is a low-level function that bypasses our
+normal schema checks, so should not be called from client programs."
+ (unless (symbolp predicate)
+ (error "Predicates in triples must always be symbols"))
+ (unless (plistp properties)
+ (error "Properties stored must always be plists"))
+ (sqlite-execute db "REPLACE INTO TRIPLES VALUES (?, ?, ?, ?)"
+ (list (triples-standardize-val subject)
+ (triples-standardize-val (triples--decolon predicate))
+ (triples-standardize-val object)
+ ;; Properties cannot be null, since in sqlite each
null value
+ ;; is distinct from each other, so replace would not
replace
+ ;; duplicate triples each with null properties.
+ (triples-standardize-val properties))))
+
+(defun triples--delete (db &optional subject predicate object properties)
+ "Delete triples matching SUBJECT, PREDICATE, OBJECT, PROPERTIES.
+If any of these are nil, they will not selected for. If you set
+all to nil, everything will be deleted, so be careful!"
+ (sqlite-execute
+ db
+ (concat "DELETE FROM TRIPLES"
+ (when (or subject predicate object properties)
+ (concat " WHERE "
+ (string-join
+ (seq-filter #'identity
+ (list (when subject "SUBJECT = ?")
+ (when predicate "PREDICATE = ?")
+ (when object "OBJECT = ?")
+ (when properties "PROPERTIES = ?")))
+ " AND "))))
+ (mapcar #'triples-standardize-val (seq-filter #'identity (list subject
predicate object properties)))))
+
+(defun triples--delete-subject-predicate-prefix (db subject pred-prefix)
+ "Delete triples matching SUBJECT and predicates with PRED-PREFIX."
+ (unless (symbolp pred-prefix)
+ (error "Predicates in triples must always be symbols"))
+ (sqlite-execute db "DELETE FROM TRIPLES WHERE subject = ? AND predicate LIKE
?"
+ (list (triples-standardize-val subject)
+ (format "%s/%%" (triples--decolon pred-prefix)))))
+
+(defun triples--select-pred-prefix (db subject pred-prefix)
+ "Return rows matching SUBJECT and PRED-PREFIX."
+ (mapcar (lambda (row) (mapcar #'triples-standardize-result row))
+ (sqlite-select db "SELECT * FROM triples WHERE subject = ? AND
predicate LIKE ?"
+ (list (triples-standardize-val subject)
+ (format "%s/%%" pred-prefix)))))
+
+(defun triples--select-predicate-object-fragment (db predicate object-fragment)
+ "Return rows with PREDICATE and with OBJECT-FRAGMENT in object."
+ (mapcar (lambda (row) (mapcar #'triples-standardize-result row))
+ (sqlite-select db "SELECT * from triples WHERE predicate = ? AND
object LIKE ?"
+ (list (triples-standardize-val predicate)
+ (format "%%%s%%" object-fragment)))))
+
+(defun triples--select (db &optional subject predicate object properties
selector)
+ "Return rows matching SUBJECT, PREDICATE, OBJECT, PROPERTIES.
+If any of these are nil, they are not included in the select
+statement. The SELECTOR is list of symbols subject, precicate,
+object, properties to retrieve or nil for *."
+ (mapcar (lambda (row) (mapcar #'triples-standardize-result row))
+ (sqlite-select db
+ (concat "SELECT "
+ (if selector
+ (mapconcat (lambda (e) (format "%s" e))
selector ", ")
+ "*") " FROM triples"
+ (when (or subject predicate object
properties)
+ (concat " WHERE "
+ (string-join
+ (seq-filter #'identity
+ (list (when subject
"SUBJECT = ?")
+ (when
predicate "PREDICATE = ?")
+ (when object
"OBJECT = ?")
+ (when
properties "PROPERTIES = ?")))
+ " AND "))))
+ (mapcar #'triples-standardize-val (seq-filter
#'identity (list subject predicate object properties))))))
(defun triples--add (db op)
"Perform OP on DB."
@@ -90,48 +180,39 @@ values."
('replace-subject
(mapc
(lambda (sub)
- (sqlite-execute db "DELETE FROM TRIPLES WHERE subject = ?"
- (list (triples-standardize-val sub))))
+ (triples--delete db sub))
(triples--subjects (cdr op))))
('replace-subject-type
(mapc (lambda (sub-triples)
(mapc (lambda (type)
;; We have to ignore base, which keeps type information
in general.
(unless (eq type 'base)
- (sqlite-execute db "DELETE FROM TRIPLES WHERE SUBJECT
= ? AND PREDICATE LIKE ?"
- (list (triples-standardize-val (car
sub-triples))
- (format "%s/%%" type)))))
+ (triples--delete-subject-predicate-prefix db (car
sub-triples) type)))
(seq-uniq
(mapcar #'car (mapcar #'triples-combined-to-type-and-prop
(mapcar #'cl-second (cdr
sub-triples)))))))
(triples--group-by-subjects (cdr op)))))
(mapc (lambda (triple)
- (sqlite-execute db "REPLACE INTO TRIPLES VALUES (?, ?, ?, ?)"
- (triples--ensure-property-val
- (apply #'vector (mapcar #'triples-standardize-val
triple)))))
+ (apply #'triples--insert db triple))
(cdr op)))
(defun triples-properties-for-predicate (db cpred)
"Return the properties in DB for combined predicate CPRED as a plist."
(mapcan (lambda (row)
(list (intern (format ":%s" (nth 1 row))) (nth 2 row)))
- (sqlite-select db "SELECT * FROM TRIPLES WHERE subject = ?"
- (list (triples-standardize-val cpred)))))
+ (triples--select db cpred)))
(defun triples-predicates-for-type (db type)
"Return all predicates defined for TYPE in DB."
(mapcar #'car
- (sqlite-select db "SELECT object FROM triples WHERE subject = ? AND
predicate = 'schema/property'"
- (list (triples-standardize-val type)))))
+ (triples--select db type 'schema/property nil nil '(object))))
(defun triples-verify-schema-compliant (db triples)
"Error if TRIPLES is not compliant with schema in DB."
(mapc (lambda (triple)
(pcase-let ((`(,type . ,prop) (triples-combined-to-type-and-prop
(nth 1 triple))))
(unless (or (eq type 'base)
- (sqlite-select db "SELECT * FROM triples WHERE subject
= ? AND predicate = 'schema/property'
-AND object = ?"
- (list (triples-standardize-val type)
(triples-standardize-val prop))))
+ (triples--select db type 'schema/property prop nil))
(error "Property %s not found in schema" (nth 1 triple)))))
triples)
(mapc (lambda (triple)
@@ -180,13 +261,13 @@ PROPERTIES is a plist of properties, without TYPE
prefixes."
The transaction will abort if an error is thrown."
(declare (indent 0) (debug t))
(let ((db-var (gensym "db")))
- `(condition-case
- (let ((,db-var ,db))
+ `(let ((,db-var ,db))
+ (condition-case nil
(progn
(sqlite-transaction ,db-var)
,@body
- (sqlite-commit ,db-var)))
- (error (sqlite-rollback ,db-var)))))
+ (sqlite-commit ,db-var))
+ (error (sqlite-rollback ,db-var))))))
(defun triples-set-types (db subject &rest combined-props)
"Set all data for types in COMBINED-PROPS in DB for SUBJECT.
@@ -201,7 +282,8 @@ given in the COMBINED-PROPS will be removed."
(plist-put (gethash (triples--decolon type) type-to-plist)
(triples--encolon prop) val) type-to-plist)))
combined-props)
- (triples-with-transaction db
+ (triples-with-transaction
+ db
(cl-loop for k being the hash-keys of type-to-plist using (hash-values v)
do (apply #'triples-set-type db subject k v)))))
@@ -230,9 +312,7 @@ PROPERTIES is a plist of properties, without TYPE prefixes."
(cons (cons (nth 2 db-triple) (nth 3 db-triple))
(gethash (nth 1 db-triple) preds))
preds))
- (sqlite-select db "SELECT * FROM triples WHERE subject = ? AND
predicate LIKE ?"
- (list (triples-standardize-val subject)
- (format "%s/%%" type))))
+ (triples--select-pred-prefix db subject type))
(append
(cl-loop for k being the hash-keys of preds using (hash-values v)
nconc (list (triples--encolon (cdr
(triples-combined-to-type-and-prop k)))
@@ -250,26 +330,20 @@ PROPERTIES is a plist of properties, without TYPE
prefixes."
:base/virtual-reversed)))
(when reversed-prop
(let ((result
- (sqlite-select db "SELECT subject FROM triples WHERE
object = ? AND predicate = ?"
- (triples-standardize-val (subject))
- reversed-prop)))
+ (triples--select db nil reversed-prop subject nil
'(subject))))
(when result (cons (triples--encolon pred) (list (mapcar
#'car result)))))))))))
(defun triples-remove-type (db subject type)
"Remove TYPE for SUBJECT in DB, and all associated data."
(triples-with-transaction
db
- (sqlite-execute db "DELETE FROM TRIPLES WHERE subject = ? AND PREDICATE =
'base/type' AND object = ?"
- (list (triples-standardize-val subject) type))
- (sqlite-execute db "DELETE FROM TRIPLES WHERE subject = ? AND PREDICATE
LIKE ?"
- (list (triples-standardize-val subject)
- (format "%s/%%" type)))))
+ (triples--delete db subject 'base/type type)
+ (triples--delete-subject-predicate-prefix db subject type)))
(defun triples-get-types (db subject)
"From DB, get all types for SUBJECT."
(mapcar #'car
- (sqlite-select db "SELECT object FROM triples WHERE subject = ? AND
predicate = 'base/type'"
- (list (triples-standardize-val subject)))))
+ (triples--select db subject 'base/type nil nil '(object))))
(defun triples-get-subject (db subject)
"From DB return all properties for SUBJECT as a single plist."
@@ -291,25 +365,19 @@ TYPE-VALS-CONS is a list of conses, combining a type and
a plist of values."
(defun triples-delete-subject (db subject)
"Delete all data in DB associated with SUBJECT."
- (sqlite-execute db "DELETE FROM triples WHERE SUBJECT = ?"
- (list (triples-standardize-val subject))))
+ (triples--delete db subject))
(defun triples-search (db cpred text)
"Search DB for instances of combined property CPRED with TEXT."
- (sqlite-select db "SELECT * FROM triples WHERE predicate = ? AND object LIKE
?"
- (list (triples--decolon cpred)
- (format "%%%s%%" text))))
+ (triples--select-predicate-object-fragment db cpred text))
(defun triples-with-predicate (db cpred)
"Return all triples in DB with CPRED as its combined predicate."
- (sqlite-select db "SELECT * FROM triples WHERE predicate = ?"
- (list (triples--decolon cpred))))
+ (triples--select db nil cpred))
(defun triples-subjects-with-predicate-object (db cpred obj)
"Return all subjects in DB with CPRED equal to OBJ."
- (sqlite-select db "SELECT subject FROM triples WHERE predicate = ? AND
object = ?"
- (list (triples--decolon cpred)
- (triples-standardize-val obj))))
+ (triples--select db nil cpred obj))
(defun triples-subjects-of-type (db type)
"Return a list of all subjects with a particular TYPE in DB."
