changelog shortlog graph tags branches changeset files revisions annotate raw help

Mercurial > demo / examples/db/xdb/document.lisp

changeset 44: 99d4ab4f8d53
parent: 81b7333f27f8
author: Richard Westhaver <ellis@rwest.io>
date: Sun, 11 Aug 2024 01:50:18 -0400
permissions: -rw-r--r--
description: update 
     1 ;;; obj/db/document.lisp --- Database Document Objects
     2 
     3 ;; Spliced from XDB, currently not in use outside of it
     4 
     5 ;;; Code:
     6 (in-package :xdb)
     7 ;;; Document
     8 (defclass document ()
     9   ((collection :initarg :collection
    10                :accessor collection)
    11    (key :initarg :key
    12         :accessor key)
    13    (doc-type :initarg :doc-type
    14              :initform nil
    15              :accessor doc-type)))
    16 
    17 (defmethod duplicate-doc-p ((doc document) test-doc)
    18   (or (eq doc test-doc)
    19       (equal (key doc) (key test-doc))))
    20 
    21 (defmethod add ((doc document) &key collection duplicate-doc-p-func)
    22   (when doc
    23     (if (slot-boundp doc 'collection)
    24         (add-doc (or (collection doc) collection) (or duplicate-doc-p-func  #'duplicate-doc-p))
    25         (error "Must specify collection to add document to."))))
    26 
    27 (defmethod get-val ((doc document) element &optional data-type)
    28   (declare (ignore data-type))
    29   (if (slot-boundp doc element)
    30       (slot-val doc element)))
    31 
    32 (defmethod (setf get-val) (new-value (doc document) element &optional data-type)
    33   (declare (ignore data-type))
    34   (if doc
    35       (setf (slot-value doc element) new-value)))
    36 
    37 (defclass document-join (join-docs)
    38   ())
    39 
    40 (defclass document-join-result (join-result)
    41   ())
    42 
    43 (defmethod get-val ((composite-doc document-join-result) element &optional data-type)
    44   (declare (ignore data-type))
    45   (map 'list
    46        (lambda (doc)
    47          (cons (doc-type doc) (get-val doc element)))
    48        (docs composite-doc)))
    49 
    50 
    51 (defmethod get-doc ((collection document-join) value &key (element 'key) (test #'equal))
    52   (map-docs
    53    nil
    54    (lambda (doc)
    55      (when (apply test (get-val doc element) value)
    56        (return-from get-doc doc)))
    57    collection))
    58 
    59 
    60 (defmethod find-doc ((collection document-join) &key test)
    61   (if test
    62       (map-docs
    63        nil
    64        (lambda (doc)
    65          (when (apply test doc)
    66            (return-from find-doc doc)))
    67        collection)))