[elpa] externals/triples d82cc1d6b8 14/19: Finish basic sqlite layer, and fix everything so tests work.

[ELPA Syncer]

branch: externals/triples
commit d82cc1d6b8c2cc439dce20cf3399f96e27d0701a
Author: Andrew Hyatt <ahyatt@gmail.com>
Commit: Andrew Hyatt <ahyatt@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."