branch: externals/triples commit 18b66a953ba268910157a01cf1afe33b2bb1b637 Merge: 1112c57419 cf95922d9a Author: Andrew Hyatt <ahy...@gmail.com> Commit: GitHub <nore...@github.com>
Merge pull request #7 from ahyatt/whitespace-fixes Fix whitespace to conform to a standard auto-formatting --- triples-backups.el | 10 +-- triples-test.el | 203 ++++++++++++++++++++++++++--------------------------- triples-upgrade.el | 62 ++++++++-------- triples.el | 136 +++++++++++++++++------------------ 4 files changed, 205 insertions(+), 206 deletions(-) diff --git a/triples-backups.el b/triples-backups.el index 2e8036b4ab..e382f5f9da 100644 --- a/triples-backups.el +++ b/triples-backups.el @@ -33,11 +33,11 @@ loaded before any client of this db calls `triples-backups-maybe-backup', so adding your own may not always be appropriate." (triples-with-transaction db - (triples-add-schema db 'backup '(num-to-keep :base/unique t :base/type integer) - '(strategy :base/unique t :base/type symbol) - '(last-update-time :base/unique t :base/type integer)) - (triples-set-type db 'database 'backup :num-to-keep num-to-keep - :strategy strategy :last-update-time (time-convert (current-time) 'integer)))) + (triples-add-schema db 'backup '(num-to-keep :base/unique t :base/type integer) + '(strategy :base/unique t :base/type symbol) + '(last-update-time :base/unique t :base/type integer)) + (triples-set-type db 'database 'backup :num-to-keep num-to-keep + :strategy strategy :last-update-time (time-convert (current-time) 'integer)))) (defun triples-backups-configuration (db) "Returns the backup configuration set by `triples-backups-setup'. diff --git a/triples-test.el b/triples-test.el index 039aa74d18..ca637a9a8d 100644 --- a/triples-test.el +++ b/triples-test.el @@ -195,38 +195,38 @@ easily debug into it.") (let ((triples-sqlite-interface 'builtin)) (triples-test-with-temp-db (triples-add-schema db 'person - '(name :base/unique t :base/type string) - '(age :base/unique t :base/type integer)) - (triples-set-type db subject 'person :name "Alice Aardvark" :age 41) + '(name :base/unique t :base/type string) + '(age :base/unique t :base/type integer)) + (triples-set-type db subject 'person :name "Alice Aardvark" :age 41) + (should (equal (triples-get-type db subject 'person) + '(:age 41 :name "Alice Aardvark"))) + (triples-close db) + (let* ((triples-sqlite-interface 'emacsql) + (db (triples-connect db-file))) (should (equal (triples-get-type db subject 'person) '(:age 41 :name "Alice Aardvark"))) - (triples-close db) - (let* ((triples-sqlite-interface 'emacsql) - (db (triples-connect db-file))) - (should (equal (triples-get-type db subject 'person) - '(:age 41 :name "Alice Aardvark"))) - (triples-close db)) - ;; Just so the last close will work. - (setq db (triples-connect db-file)))))) + (triples-close db)) + ;; Just so the last close will work. + (setq db (triples-connect db-file)))))) (ert-deftest triples-test-emacsql-builtin-compat () (cl-loop for subject in '(1 a "a") do (let ((triples-sqlite-interface 'emacsql)) (triples-test-with-temp-db (triples-add-schema db 'person - '(name :base/unique t :base/type string) - '(age :base/unique t :base/type integer)) - (triples-set-type db subject 'person :name "Alice Aardvark" :age 41) + '(name :base/unique t :base/type string) + '(age :base/unique t :base/type integer)) + (triples-set-type db subject 'person :name "Alice Aardvark" :age 41) + (should (equal (triples-get-type db subject 'person) + '(:age 41 :name "Alice Aardvark"))) + (triples-close db) + (let* ((triples-sqlite-interface 'builtin) + (db (triples-connect db-file))) (should (equal (triples-get-type db subject 'person) '(:age 41 :name "Alice Aardvark"))) - (triples-close db) - (let* ((triples-sqlite-interface 'builtin) - (db (triples-connect db-file))) - (should (equal (triples-get-type db subject 'person) - '(:age 41 :name "Alice Aardvark"))) - (triples-close db)) - ;; Just so the last close will work. - (setq db (triples-connect db-file)))))) + (triples-close db)) + ;; Just so the last close will work. + (setq db (triples-connect db-file)))))) (ert-deftest triples-test-emacsql-to-sqlite-dup-fixing () (let ((triples-sqlite-interface 'emacsql) @@ -245,7 +245,6 @@ easily debug into it.") (should (= 2 (length (triples-get-subject db 1)))) (triples-close db) (delete-file db-file))) - ;; After this we don't bother testing both with emacsql and the builtin sqlite, ;; since if the functions tested above work, it should also work for both. @@ -281,7 +280,7 @@ easily debug into it.") (triples-add-schema db 'named '(name :base/unique t) 'alternate-names) (should (equal '(:base/unique t) - (triples-properties-for-predicate db 'named/name))) + (triples-properties-for-predicate db 'named/name))) (should (equal (triples-test-list-sort '(name alternate-names)) (triples-test-list-sort (triples-predicates-for-type db 'named)))))) @@ -292,7 +291,7 @@ easily debug into it.") '(name :base/unique t) 'alternate-names) (should (equal '(:base/unique t) - (triples-properties-for-predicate db 'named/name))) + (triples-properties-for-predicate db 'named/name))) (should-not (triples-properties-for-predicate db 'foo/bar)))) (ert-deftest triples-set-type () @@ -331,22 +330,22 @@ easily debug into it.") (ert-deftest triples-crud () (triples-test-with-temp-db - (triples-add-schema db 'named - '(name :base/unique t) - 'alias) - (triples-add-schema db 'callable - '(phone-number :base/unique t)) - (triples-set-type db "foo" 'named :name "Name" :alias '("alias1" "alias2")) - (triples-set-type db "foo" 'callable :phone-number "867-5309") - (should (equal (triples-test-plist-sort '(:name "Name" :alias ("alias1" "alias2"))) - (triples-test-plist-sort (triples-get-type db "foo" 'named)))) - (should (equal (triples-test-list-sort (triples-get-types db "foo")) - (triples-test-list-sort '(callable named)))) - (should-not (triples-get-type db "bar" 'named)) - (should-not (triples-get-types db "bar")) - (triples-remove-type db "foo" 'named) - (should-not (triples-get-type db "foo" 'named)) - (should (triples-get-type db "foo" 'callable)))) + (triples-add-schema db 'named + '(name :base/unique t) + 'alias) + (triples-add-schema db 'callable + '(phone-number :base/unique t)) + (triples-set-type db "foo" 'named :name "Name" :alias '("alias1" "alias2")) + (triples-set-type db "foo" 'callable :phone-number "867-5309") + (should (equal (triples-test-plist-sort '(:name "Name" :alias ("alias1" "alias2"))) + (triples-test-plist-sort (triples-get-type db "foo" 'named)))) + (should (equal (triples-test-list-sort (triples-get-types db "foo")) + (triples-test-list-sort '(callable named)))) + (should-not (triples-get-type db "bar" 'named)) + (should-not (triples-get-types db "bar")) + (triples-remove-type db "foo" 'named) + (should-not (triples-get-type db "foo" 'named)) + (should (triples-get-type db "foo" 'callable)))) (ert-deftest triples-crud-all () (triples-test-with-temp-db @@ -366,7 +365,7 @@ easily debug into it.") (triples-test-with-temp-db (triples-add-schema db 'named '(name :base/unique t) - 'alias) + 'alias) (triples-add-schema db 'reachable 'phone) (triples-set-type db "foo" 'named :name "Name" :alias '("alias1" "alias2")) (triples-set-types db "foo" :named/name "New Name" :reachable/phone '("867-5309")) @@ -375,10 +374,10 @@ easily debug into it.") (ert-deftest triples-single-element () (triples-test-with-temp-db - (triples-add-schema db 'named 'name) - (triples-set-type db "foo" 'named :name '("Name")) - (should (equal '(:name ("Name")) - (triples-get-type db "foo" 'named))))) + (triples-add-schema db 'named 'name) + (triples-set-type db "foo" 'named :name '("Name")) + (should (equal '(:name ("Name")) + (triples-get-type db "foo" 'named))))) (ert-deftest triples-store-and-retrieve () (triples-test-with-temp-db @@ -392,52 +391,52 @@ easily debug into it.") (ert-deftest triples-vector () (triples-test-with-temp-db - (triples-add-schema db 'named 'name) - (triples-add-schema db 'embedding '(embedding :base/unique t :base/type vector)) - (triples-set-type db "foo" 'named :name '("Name")) - (triples-set-type db "foo" 'embedding :embedding [1 2 3 4 5]) - (should (equal '(:embedding [1 2 3 4 5]) - (triples-get-type db "foo" 'embedding))) - (should-error (triples-set-type db "foo" 'embedding :embedding '(1 2 3))))) + (triples-add-schema db 'named 'name) + (triples-add-schema db 'embedding '(embedding :base/unique t :base/type vector)) + (triples-set-type db "foo" 'named :name '("Name")) + (triples-set-type db "foo" 'embedding :embedding [1 2 3 4 5]) + (should (equal '(:embedding [1 2 3 4 5]) + (triples-get-type db "foo" 'embedding))) + (should-error (triples-set-type db "foo" 'embedding :embedding '(1 2 3))))) (ert-deftest triples-cons () (triples-test-with-temp-db - (triples-add-schema db 'data '(data :base/unique t :base/type cons)) - (triples-set-type db "foo" 'data :data '(a (b c))) - (should (equal '(:data (a (b c))) - (triples-get-type db "foo" 'data))) - (should (= 1 (length (triples-db-select db nil 'data/data)))) - ;; Let's also make sure if we store it as a straight list triples doesn't get - ;; confused and try to store it as separate rows in the db. - (triples-set-type db "foo" 'data :data '(a b c)) - (should (= 1 (length (triples-db-select db nil 'data/data)))))) + (triples-add-schema db 'data '(data :base/unique t :base/type cons)) + (triples-set-type db "foo" 'data :data '(a (b c))) + (should (equal '(:data (a (b c))) + (triples-get-type db "foo" 'data))) + (should (= 1 (length (triples-db-select db nil 'data/data)))) + ;; Let's also make sure if we store it as a straight list triples doesn't get + ;; confused and try to store it as separate rows in the db. + (triples-set-type db "foo" 'data :data '(a b c)) + (should (= 1 (length (triples-db-select db nil 'data/data)))))) (ert-deftest triples-reversed () (triples-test-with-temp-db - (triples-add-schema db 'named - '(name :base/unique t) - '(locale :base/unique t)) - (triples-add-schema db 'locale - '(used-in-name :base/virtual-reversed named/locale)) - (triples-set-type db "en/US" 'locale nil) - (should-not (triples-get-type db "en/US" 'locale)) - (triples-set-type db "foo" 'named :name "foo" :locale "en/US") - (should (equal '(:used-in-name ("foo")) - (triples-get-type db "en/US" 'locale))) - (should-error (triples-set-type db "en/US" 'locale :used-in-name '("bar"))))) + (triples-add-schema db 'named + '(name :base/unique t) + '(locale :base/unique t)) + (triples-add-schema db 'locale + '(used-in-name :base/virtual-reversed named/locale)) + (triples-set-type db "en/US" 'locale nil) + (should-not (triples-get-type db "en/US" 'locale)) + (triples-set-type db "foo" 'named :name "foo" :locale "en/US") + (should (equal '(:used-in-name ("foo")) + (triples-get-type db "en/US" 'locale))) + (should-error (triples-set-type db "en/US" 'locale :used-in-name '("bar"))))) (ert-deftest triples-with-predicate () (triples-test-with-temp-db - (triples-add-schema 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 - (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)))))) + (triples-add-schema 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 + (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 @@ -463,18 +462,18 @@ easily debug into it.") (ert-deftest triples-move-subject () (triples-test-with-temp-db - (triples-add-schema db 'named '(name :base/unique t)) - (triples-add-schema db 'friend '(id :base/unique t)) - (triples-set-subject db 123 '(named :name "Ada Lovelace")) - (triples-set-subject db 456 '(named :name "Michael Faraday") - '(friend :id 123)) - (triples-set-subject db 987 '(named :name "To Be Deleted")) - (should-error (triples-move-subject db 123 987)) - (triples-delete-subject db 987) - (triples-move-subject db 123 987) - (should-not (triples-get-subject db 123)) - (should (equal "Ada Lovelace" (plist-get (triples-get-subject db 987) :named/name))) - (should (equal 987 (plist-get (triples-get-subject db 456) :friend/id))))) + (triples-add-schema db 'named '(name :base/unique t)) + (triples-add-schema db 'friend '(id :base/unique t)) + (triples-set-subject db 123 '(named :name "Ada Lovelace")) + (triples-set-subject db 456 '(named :name "Michael Faraday") + '(friend :id 123)) + (triples-set-subject db 987 '(named :name "To Be Deleted")) + (should-error (triples-move-subject db 123 987)) + (triples-delete-subject db 987) + (triples-move-subject db 123 987) + (should-not (triples-get-subject db 123)) + (should (equal "Ada Lovelace" (plist-get (triples-get-subject db 987) :named/name))) + (should (equal 987 (plist-get (triples-get-subject db 456) :friend/id))))) (ert-deftest triples-test-subjects-with-predicate-object-unique-subject () (triples-test-with-temp-db @@ -484,17 +483,17 @@ easily debug into it.") (ert-deftest triples-test-schema-and-data-with-same-subject () (triples-test-with-temp-db - (triples-add-schema db 'foo '(bar)) - (triples-set-subject db 'foo '(foo :bar "baz")) - (should (equal "baz" (plist-get (triples-get-subject db 'foo) :foo/bar))) - (triples-add-schema db 'foo '(bar)) - (should (equal "baz" (plist-get (triples-get-subject db 'foo) :foo/bar))))) + (triples-add-schema db 'foo '(bar)) + (triples-set-subject db 'foo '(foo :bar "baz")) + (should (equal "baz" (plist-get (triples-get-subject db 'foo) :foo/bar))) + (triples-add-schema db 'foo '(bar)) + (should (equal "baz" (plist-get (triples-get-subject db 'foo) :foo/bar))))) (ert-deftest triples-readme () (triples-test-with-temp-db (triples-add-schema db 'person - '(name :base/unique t :base/type string) - '(age :base/unique t :base/type integer)) + '(name :base/unique t :base/type string) + '(age :base/unique t :base/type integer)) (triples-add-schema db 'employee '(id :base/unique t :base/type integer) '(manager :base/unique t) diff --git a/triples-upgrade.el b/triples-upgrade.el index 29caae17b9..4a144c0ed2 100644 --- a/triples-upgrade.el +++ b/triples-upgrade.el @@ -50,37 +50,37 @@ be correct by default." (message "triples: Upgrading triples schema to 0.3") (triples-rebuild-builtin-database db) (let ((replace-approved)) - (mapc (lambda (column) - ;; This would all be easier if sqlite supported REGEXP, but - ;; instead we have to programmatically examine each string to see if it - ;; is an integer. - (mapc (lambda (row) - (let ((string-val (car row))) - (when (string-match (rx (seq string-start (opt ?\") (group-n 1 (1+ digit))) (opt ?\") string-end) - string-val) - (message "triples: Upgrading %s with integer string value %s to a real integer" column string-val) - ;; Subject transformations have to be treated - ;; carefully, since they could end up duplicating - ;; predicates. - (let ((int-val (string-to-number (match-string 1 string-val)))) - (when (equal column "subject") - (when (and (> (caar (sqlite-execute db "SELECT count(*) FROM triples WHERE subject = ? AND typeof(subject) = 'integer'" - (list int-val))) 0) - (or replace-approved - (y-or-n-p (format "triples: For subject %d, existing real integer subject found. Replace for this and others? " - int-val)))) - (setq replace-approved t) - (sqlite-execute db "DELETE FROM triples WHERE subject = ? AND typeof(subject) = 'integer'" - (list int-val)))) - (sqlite-execute db (format "UPDATE OR REPLACE triples SET %s = cast(REPLACE(%s, '\"', '') as integer) WHERE %s = ?" - column column column) - (list string-val)))))) - (sqlite-select - db - (format "SELECT %s from triples WHERE cast(REPLACE(%s, '\"', '') as integer) > 0 AND typeof(%s) = 'text' GROUP BY %s" - column column column column)))) - '("subject" "object")) - (message "Upgraded all stringified integers in triple database to actual integers")))) + (mapc (lambda (column) + ;; This would all be easier if sqlite supported REGEXP, but + ;; instead we have to programmatically examine each string to see if it + ;; is an integer. + (mapc (lambda (row) + (let ((string-val (car row))) + (when (string-match (rx (seq string-start (opt ?\") (group-n 1 (1+ digit))) (opt ?\") string-end) + string-val) + (message "triples: Upgrading %s with integer string value %s to a real integer" column string-val) + ;; Subject transformations have to be treated + ;; carefully, since they could end up duplicating + ;; predicates. + (let ((int-val (string-to-number (match-string 1 string-val)))) + (when (equal column "subject") + (when (and (> (caar (sqlite-execute db "SELECT count(*) FROM triples WHERE subject = ? AND typeof(subject) = 'integer'" + (list int-val))) 0) + (or replace-approved + (y-or-n-p (format "triples: For subject %d, existing real integer subject found. Replace for this and others? " + int-val)))) + (setq replace-approved t) + (sqlite-execute db "DELETE FROM triples WHERE subject = ? AND typeof(subject) = 'integer'" + (list int-val)))) + (sqlite-execute db (format "UPDATE OR REPLACE triples SET %s = cast(REPLACE(%s, '\"', '') as integer) WHERE %s = ?" + column column column) + (list string-val)))))) + (sqlite-select + db + (format "SELECT %s from triples WHERE cast(REPLACE(%s, '\"', '') as integer) > 0 AND typeof(%s) = 'text' GROUP BY %s" + column column column column)))) + '("subject" "object")) + (message "Upgraded all stringified integers in triple database to actual integers")))) (provide 'triples-upgrade) ;; triples-upgrade ends here diff --git a/triples.el b/triples.el index 4fdb8d0852..25364d04c0 100644 --- a/triples.el +++ b/triples.el @@ -71,11 +71,11 @@ The transaction will abort if an error is thrown." "Rebuild the builtin database DB. This is used in upgrades and when problems are detected." (triples-with-transaction - db - (sqlite-execute db "ALTER TABLE triples RENAME TO triples_old") - (triples-setup-table-for-builtin db) - (sqlite-execute db "INSERT INTO triples (subject, predicate, object, properties) SELECT DISTINCT subject, predicate, object, properties FROM triples_old") - (sqlite-execute db "DROP TABLE triples_old"))) + db + (sqlite-execute db "ALTER TABLE triples RENAME TO triples_old") + (triples-setup-table-for-builtin db) + (sqlite-execute db "INSERT INTO triples (subject, predicate, object, properties) SELECT DISTINCT subject, predicate, object, properties FROM triples_old") + (sqlite-execute db "DROP TABLE triples_old"))) (defun triples-maybe-upgrade-to-builtin (db) "Check to see if DB needs to be upgraded from emacsql to builtin." @@ -84,7 +84,7 @@ This is used in upgrades and when problems are detected." (when (> (caar (sqlite-select db "SELECT COUNT(*) FROM triples WHERE properties = '(:t t)'")) 0) (if (> (caar (sqlite-select db "SELECT COUNT(*) FROM triples WHERE properties = '()'")) - 0) + 0) (progn (message "triples: detected data written with both builtin and emacsql, upgrading and removing duplicates") ;; Where we can, let's just upgrade the old data. However, sometimes we cannot due to duplicates. @@ -98,9 +98,9 @@ This is used in upgrades and when problems are detected." "Connect to the database FILE and make sure it is populated. If FILE is nil, use `triples-default-database-filename'." (unless (pcase-exhaustive triples-sqlite-interface - ('builtin - (and (fboundp 'sqlite-available-p) (sqlite-available-p))) - ('emacsql (require 'emacsql nil t))) + ('builtin + (and (fboundp 'sqlite-available-p) (sqlite-available-p))) + ('emacsql (require 'emacsql nil t))) (error "The triples package requires either Emacs 29 or the emacsql package to be installed.")) (let ((file (or file triples-default-database-filename))) (pcase triples-sqlite-interface @@ -211,8 +211,8 @@ 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 (numberp result) - result - (read result))) + result + (read result))) (defun triples-db-insert (db subject predicate object &optional properties) "Insert triple to DB: SUBJECT, PREDICATE, OBJECT with PROPERTIES. @@ -295,8 +295,8 @@ all to nil, everything will be deleted, so be careful!" (error "Predicates in triples must always be symbols")) (pcase triples-sqlite-interface ('builtin (sqlite-execute db "DELETE FROM triples WHERE subject = ? AND predicate LIKE ?" - (list (triples-standardize-val subject) - (format "%s/%%" (triples--decolon pred-prefix))))) + (list (triples-standardize-val subject) + (format "%s/%%" (triples--decolon pred-prefix))))) ('emacsql (emacsql db [:delete :from triples :where (= subject $s1) :and (like predicate $r2)] subject (format "%s/%%" (triples--decolon pred-prefix)))))) @@ -313,7 +313,7 @@ If PROPERTIES is given, triples must match the given properties." (let ((pred (triples--decolon pred))) (pcase triples-sqlite-interface ('builtin - (mapcar (lambda (row) (mapcar #'triples-standardize-result row)) + (mapcar (lambda (row) (mapcar #'triples-standardize-result row)) (sqlite-select db (concat "SELECT * FROM triples WHERE predicate = ? AND " @@ -347,9 +347,9 @@ If PROPERTIES is given, triples must match the given properties." "Return rows matching SUBJECT and PRED-PREFIX." (pcase triples-sqlite-interface ('builtin (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))))) + (sqlite-select db "SELECT * FROM triples WHERE subject = ? AND predicate LIKE ?" + (list (triples-standardize-val subject) + (format "%s/%%" pred-prefix))))) ('emacsql (emacsql db [:select * :from triples :where (= subject $s1) :and (like predicate $r2)] subject (format "%s/%%" pred-prefix))))) @@ -414,10 +414,10 @@ merged into NEW-SUBJECT." (signal 'error err)))) ('emacsql (emacsql-with-transaction db - (emacsql db [:update triples :set (= subject $s1) :where (= subject $s2)] - new-subject old-subject) - (emacsql db [:update triples :set (= object $s1) :where (= object $s2)] - new-subject old-subject))))) + (emacsql db [:update triples :set (= subject $s1) :where (= subject $s2)] + new-subject old-subject) + (emacsql db [:update triples :set (= object $s1) :where (= object $s2)] + new-subject old-subject))))) ;; Code after this point should not call sqlite or emacsql directly. If any more ;; calls are needed, put them in a defun, make it work for sqlite and emacsql, @@ -440,24 +440,24 @@ merged into NEW-SUBJECT." (defun triples--add (db op) "Perform OP on DB." (pcase (car op) - ('replace-subject - (mapc - (lambda (sub) - (triples-db-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) - (triples-db-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))))) + ('replace-subject + (mapc + (lambda (sub) + (triples-db-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) + (triples-db-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) (apply #'triples-db-insert db triple)) - (cdr op))) + (cdr op))) (defun triples-properties-for-predicate (db cpred) "Return the properties in DB for combined predicate CPRED as a plist." @@ -484,8 +484,8 @@ definitions." (triples--plist-mapc (lambda (pred-prop val) (let ((f (intern (format "triples-verify-%s-compliant" (triples--decolon pred-prop))))) - (if (fboundp f) - (funcall f val triple)))) + (if (fboundp f) + (funcall f val triple)))) (cdr (assoc (nth 1 triple) prop-schema-alist)))) triples)) (defun triples-add-schema (db type &rest props) @@ -506,13 +506,13 @@ them." (pcombined (intern (format "%s/%s" type pname)))) (cons (list type 'schema/property pname) (seq-filter #'identity - (triples--plist-mapcar - (lambda (k v) - ;; If V is nil, that's the default, so don't - ;; store anything. - (when v - (list pcombined (triples--decolon k) v))) - pprops)))))))) + (triples--plist-mapcar + (lambda (k v) + ;; If V is nil, that's the default, so don't + ;; store anything. + (when v + (list pcombined (triples--decolon k) v))) + pprops)))))))) (defun triples-set-type (db subject type &rest properties) "Create operation to replace PROPERTIES for TYPE for SUBJECT in DB. @@ -543,17 +543,17 @@ PROPERTIES is a plist of properties, without TYPE prefixes." (defun triples--with-transaction (db body-fun) (pcase triples-sqlite-interface - ('builtin (condition-case err - (progn - (sqlite-transaction db) - (funcall body-fun) - (sqlite-commit db)) - (error (sqlite-rollback db) - (signal (car err) (cdr err))))) - ('emacsql (funcall (triples--eval-when-fboundp emacsql-with-transaction - (lambda (db body-fun) - (emacsql-with-transaction db (funcall body-fun)))) - db body-fun)))) + ('builtin (condition-case err + (progn + (sqlite-transaction db) + (funcall body-fun) + (sqlite-commit db)) + (error (sqlite-rollback db) + (signal (car err) (cdr err))))) + ('emacsql (funcall (triples--eval-when-fboundp emacsql-with-transaction + (lambda (db body-fun) + (emacsql-with-transaction db (funcall body-fun)))) + db body-fun)))) (defun triples-set-types (db subject &rest combined-props) "Set all data for types in COMBINED-PROPS in DB for SUBJECT. @@ -587,13 +587,13 @@ broken down into separate rows, and when to leave as is." (if (and (listp v) (not (plist-get prop-schema :base/unique))) - (cl-loop for e in v for i from 0 - collect - (list subject - (triples-type-and-prop-to-combined type prop) - e - (list :index i))) - (list (list subject (triples-type-and-prop-to-combined type prop) v))))) + (cl-loop for e in v for i from 0 + collect + (list subject + (triples-type-and-prop-to-combined type prop) + e + (list :index i))) + (list (list subject (triples-type-and-prop-to-combined type prop) v))))) properties)))) (defun triples-get-type (db subject type) @@ -650,10 +650,10 @@ broken down into separate rows, and when to leave as is." "From DB set properties of SUBJECT to TYPE-VALS-CONS data. TYPE-VALS-CONS is a list of conses, combining a type and a plist of values." (triples-with-transaction db - (triples-delete-subject db subject) - (mapc (lambda (cons) - (apply #'triples-set-type db subject cons)) - type-vals-cons))) + (triples-delete-subject db subject) + (mapc (lambda (cons) + (apply #'triples-set-type db subject cons)) + type-vals-cons))) (defun triples-delete-subject (db subject) "Delete all data in DB associated with SUBJECT.