1.1--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.2+++ b/examples/db/xdb/document.lisp	Sun Jun 16 22:15:04 2024 -0400
     1.3@@ -0,0 +1,67 @@
     1.4+;;; obj/db/document.lisp --- Database Document Objects
     1.5+
     1.6+;; Spliced from XDB, currently not in use outside of it
     1.7+
     1.8+;;; Code:
     1.9+(in-package :xdb)
    1.10+;;; Document
    1.11+(defclass document ()
    1.12+  ((collection :initarg :collection
    1.13+               :accessor collection)
    1.14+   (key :initarg :key
    1.15+        :accessor key)
    1.16+   (doc-type :initarg :doc-type
    1.17+             :initform nil
    1.18+             :accessor doc-type)))
    1.19+
    1.20+(defmethod duplicate-doc-p ((doc document) test-doc)
    1.21+  (or (eq doc test-doc)
    1.22+      (equal (key doc) (key test-doc))))
    1.23+
    1.24+(defmethod add ((doc document) &key collection duplicate-doc-p-func)
    1.25+  (when doc
    1.26+    (if (slot-boundp doc 'collection)
    1.27+        (add-doc (or (collection doc) collection) (or duplicate-doc-p-func  #'duplicate-doc-p))
    1.28+        (error "Must specify collection to add document to."))))
    1.29+
    1.30+(defmethod get-val ((doc document) element &optional data-type)
    1.31+  (declare (ignore data-type))
    1.32+  (if (slot-boundp doc element)
    1.33+      (slot-val doc element)))
    1.34+
    1.35+(defmethod (setf get-val) (new-value (doc document) element &optional data-type)
    1.36+  (declare (ignore data-type))
    1.37+  (if doc
    1.38+      (setf (slot-value doc element) new-value)))
    1.39+
    1.40+(defclass document-join (join-docs)
    1.41+  ())
    1.42+
    1.43+(defclass document-join-result (join-result)
    1.44+  ())
    1.45+
    1.46+(defmethod get-val ((composite-doc document-join-result) element &optional data-type)
    1.47+  (declare (ignore data-type))
    1.48+  (map 'list
    1.49+       (lambda (doc)
    1.50+         (cons (doc-type doc) (get-val doc element)))
    1.51+       (docs composite-doc)))
    1.52+
    1.53+
    1.54+(defmethod get-doc ((collection document-join) value &key (element 'key) (test #'equal))
    1.55+  (map-docs
    1.56+   nil
    1.57+   (lambda (doc)
    1.58+     (when (apply test (get-val doc element) value)
    1.59+       (return-from get-doc doc)))
    1.60+   collection))
    1.61+
    1.62+
    1.63+(defmethod find-doc ((collection document-join) &key test)
    1.64+  (if test
    1.65+      (map-docs
    1.66+       nil
    1.67+       (lambda (doc)
    1.68+         (when (apply test doc)
    1.69+           (return-from find-doc doc)))
    1.70+       collection)))