[elpa] externals/triples 762387f22b 1/4: Add triples-db-count and triples-remove-schema-type

[ELPA Syncer]

branch: externals/triples
commit 762387f22b25206038278947105650fc22404025
Author: Andrew Hyatt <ahyatt@gmail.com>
Commit: Andrew Hyatt <ahyatt@gmail.com>

    Add triples-db-count and triples-remove-schema-type
---
 README.org      |  1 +
 triples-test.el | 24 ++++++++++++++++++------
 triples.el      | 38 ++++++++++++++++++++++++++++++++------
 3 files changed, 51 insertions(+), 12 deletions(-)

diff --git a/README.org b/README.org
index b08f6de3cf..ec0d07d44a 100644
--- a/README.org
+++ b/README.org
@@ -91,6 +91,7 @@ There are other useful functions, including:
 - =triples-with-predicate=, gets all triples that is about a specific property,
 - =triples-subject-with-predicate-object=, get all subjects whose predicate is 
equal to /object/,
 - =triples-subjects-of-type=, get all subjects which have a particular type.
+- =triples-remove-schema-type= , remove a type and all associated data from 
the schema (should be rarely used).
 ** Predicates, with type and without
 Sometimes the triples library will require predicates that are without type, 
and sometimes with type, or "combined predicates".  The rule is that if the 
type is already specified in the function, it does not need to be respecified.  
If the type is not specified, it is included in the combined predicate.
 
diff --git a/triples-test.el b/triples-test.el
index ca637a9a8d..a476ccfcce 100644
--- a/triples-test.el
+++ b/triples-test.el
@@ -88,7 +88,7 @@ easily debug into it.")
                      '(("\"sub\"" "pred" "\"obj\"" "()")))))
     ;; Test that it replaces - this shouldn't result in two rows.
     (triples-db-insert db "sub" 'pred "obj")
-    (should (= (length (triples-db-select db)) 1))
+    (should (= (triples-count db) 1))
     ;; Test that colons in the predicate are stripped away when stored.
     (triples-db-insert db "sub" :test/pred "obj")
     (should (= (length (triples-db-select db nil 'test/pred)) 1))
@@ -103,7 +103,7 @@ easily debug into it.")
              '((sub pred obj))))
     ;; Test that properties aren't strings. They happen to be stored
     ;; differently for each system due to differences in how the inserting
-    ;; interface works.
+    ;; face works.
     (should (plistp (nth 3 (car (triples-db-select db 'sub)))))))
 
 (triples-deftest triples-test-delete ()
@@ -111,24 +111,24 @@ easily debug into it.")
     (triples-db-insert db 1 'pred 2)
     (triples-db-insert db 2 'pred 1)
     (triples-db-delete db 1)
-    (should (= 1 (length (triples-db-select db))))
+    (should (= 1 (triples-count db)))
     (should (= 0 (length (triples-db-select db 1))))
     (triples-db-insert db 1 'pred 2)
     (triples-db-delete db nil nil 2)
     (should (= 0 (length (triples-db-select db nil nil 2))))
     (triples-db-insert db 1 'pred 2)
     (triples-db-delete db nil 'pred nil)
-    (should (= 0 (length (triples-db-select db))))))
+    (should (= 0 (triples-count db)))))
 
 (triples-deftest triples-test-delete-subject-predicate-prefix ()
   (triples-test-with-temp-db
     (triples-db-insert db 1 'test/foo 2)
     (triples-db-insert db 1 'bar/bar 1)
     (triples-db-delete-subject-predicate-prefix db 1 'test)
-    (should (= 1 (length (triples-db-select db))))
+    (should (= 1 (triples-count db)))
     ;; Make sure colons are stripped.
     (triples-db-delete-subject-predicate-prefix db 1 :bar)
-    (should (= 0 (length (triples-db-select db))))))
+    (should (= 0 (triples-count db)))))
 
 (triples-deftest triples-test-select ()
   (triples-test-with-temp-db
@@ -489,6 +489,18 @@ easily debug into it.")
     (triples-add-schema db 'foo '(bar))
     (should (equal "baz" (plist-get (triples-get-subject db 'foo) :foo/bar)))))
 
+(ert-deftest triples-test-remove-schema-type ()
+  (triples-test-with-temp-db
+    (should (= 0 (triples-count db)))
+    (triples-add-schema db 'named '(name))
+    (triples-set-type db "foo" 'named :name "My Name Is Fred Foo")
+    (triples-remove-schema-type db 'named)
+    (should-not (triples-get-type db 'named 'base/type))
+    (should-not (triples-get-type db "foo" 'named))
+    (should-error (triples-set-type db "foo" 'named :name "My Name Is Fred 
Foo"))
+    (ert-info ((format "Triples: %s" (triples-db-select db)))
+      (should (= 0 (triples-count db))))))
+
 (ert-deftest triples-readme ()
   (triples-test-with-temp-db
     (triples-add-schema db 'person
diff --git a/triples.el b/triples.el
index 25364d04c0..31db47a55c 100644
--- a/triples.el
+++ b/triples.el
@@ -393,6 +393,12 @@ object, properties to retrieve or nil for *."
                                  (when properties `((= properties ,(intern 
(format "$s%d" (cl-incf n)))))))))))
               (seq-filter #'identity (list subject predicate object 
properties)))))))
 
+(defun triples-db-count (db)
+  "Return the number of triples in DB."
+  (pcase triples-sqlite-interface
+    ('builtin (caar (sqlite-select db "SELECT COUNT(*) FROM triples")))
+    ('emacsql (caar (emacsql db [:select (funcall count *) :from triples])))))
+
 (defun triples-move-subject (db old-subject new-subject)
   "Replace all instance in DB of OLD-SUBJECT to NEW-SUBJECT.
 Any references to OLD-SUBJECT as an object are also replaced.
@@ -514,16 +520,36 @@ them."
                                                 (list pcombined 
(triples--decolon k) v)))
                                             pprops))))))))
 
+(defun triples-remove-schema-type (db type)
+  "This removes the schema for TYPE in DB, and all associated data."
+  (triples-with-transaction
+    db
+    (let ((subjects (triples-subjects-of-type db type)))
+      (mapc (lambda (subject)
+              (triples-remove-type db subject type))
+            subjects)
+      (triples-remove-type db type 'schema))))
+
+(defun triples-count (db)
+  "Return the number of triples in DB."
+  (triples-db-count db))
+
 (defun triples-set-type (db subject type &rest properties)
   "Create operation to replace PROPERTIES for TYPE for SUBJECT in DB.
 PROPERTIES is a plist of properties, without TYPE prefixes."
   (let* ((prop-schema-alist
-          (mapcar (lambda (prop)
-                    (cons (triples--decolon prop)
-                          (triples-properties-for-predicate
-                           db
-                           (triples-type-and-prop-to-combined type prop))))
-                  (triples--plist-mapcar (lambda (k _) k) properties)))
+          ;; If the type doesn't exist, there is no schema to check against.
+          (when (triples-get-type db type 'schema)
+            (triples--plist-mapcar
+             (lambda (k v)
+               (cons (triples--decolon k) v))
+             (triples-properties-for-predicate db 
(triples-type-and-prop-to-combined type 'schema/property)))
+            (mapcar (lambda (prop)
+                      (cons (triples--decolon prop)
+                            (triples-properties-for-predicate
+                             db
+                             (triples-type-and-prop-to-combined type prop))))
+                    (triples--plist-mapcar (lambda (k _) k) properties))))
          (op (triples--set-type-op subject type properties prop-schema-alist)))
     (triples-verify-schema-compliant
      (cdr op)