changelog shortlog graph tags branches changeset files revisions annotate raw help

Mercurial > core / lisp/lib/obj/db.lisp

changeset 698: 96958d3eb5b0
parent: 97dd03beda03
author: Richard Westhaver <ellis@rwest.io>
date: Fri, 04 Oct 2024 22:04:59 -0400
permissions: -rw-r--r--
description: fixes 
     1 ;;; lib/obj/db/proto.lisp --- Database Protocol
     2 
     3 ;;
     4 
     5 ;;; Commentary:
     6 
     7 ;; This set of 
     8 
     9 ;;; Code:
    10 (in-package :obj/db)
    11 
    12 ;;; Vars
    13 (declaim (sb-kernel:type-specifier *default-database-type* *default-database-collection-type*))
    14 (defparameter *default-database-type* 'vector)
    15 (defparameter *default-database-collection-type* 'list)
    16 
    17 ;;; Database
    18 (defgeneric db (self)
    19   (:documentation "Return the Database associated with SELF."))
    20 
    21 (defclass database ()
    22   ((db :initform nil :initarg :db :accessor db)))
    23 
    24 (defclass database-collection () ())
    25 
    26 ;; TODO 2024-05-30: maybe make into a macro?
    27 (defgeneric make-db (engine &rest initargs &key &allow-other-keys)
    28   (:documentation "Dispatch initializer for databases. An ENGINE must be supplied, which is
    29 usually a key such as :ROCKSDB or :SQLITE."))
    30 
    31 (defgeneric connect-db (db &key &allow-other-keys)
    32   (:documentation "Connect the database DB."))
    33 
    34 (defgeneric query-db (db query &key &allow-other-keys)
    35   (:documentation "Execute QUERY against DB."))
    36 
    37 (defgeneric db-get (db key &key &allow-other-keys)
    38   (:documentation "Return the value associated with KEY from DB."))
    39 
    40 (defgeneric (setf db-get) (db key val &key &allow-other-keys))
    41 
    42 (defgeneric close-db (db &key &allow-other-keys)
    43   (:documentation "Close the database DB."))
    44 
    45 (defgeneric open-db (self))
    46 
    47 (defgeneric destroy-db (self)
    48   (:documentation "Destroy all traces of a database, deleting any on-disk data and shutting down
    49 in-memory objects."))
    50 
    51 (defgeneric find-db (dbs name &key &allow-other-keys)
    52   (:documentation "Return the db by NAME, from a collection of databases DBS."))
    53 
    54 (defgeneric insert-db (dbs name &key &allow-other-keys)
    55   (:documentation "Inserts a database by NAME into the database-collection DBS."))
    56 
    57 (defgeneric db-open-p (self)
    58   (:documentation "Return T when database SELF is open.")
    59   (:method ((self t)) nil)
    60   (:method ((self database)) (when (db self) t)))
    61 
    62 (defgeneric db-closed-p (self)
    63   (:documentation "Return T when database SELF is closed.")
    64   (:method ((self t)) t)
    65   (:method ((self database)) (unless (db self) t)))
    66 
    67 ;;; Common
    68 (defun slot-val (instance slot-name)
    69   (if (and instance
    70            (slot-boundp instance slot-name))
    71       (slot-value instance slot-name)))
    72 
    73 (defgeneric get-val (object element &optional data-type)
    74   (:documentation "Returns the value in a object based on the supplied element name and possible
    75 type hints.")
    76   (:method (object element &optional data-type)
    77   (when object
    78     (typecase (or data-type object)
    79       (hash-table
    80        (gethash element object))
    81       (standard-object
    82        (slot-val object element))
    83       (t
    84        (if data-type
    85            (cond 
    86              ((equal 'alist data-type)
    87               (second (assoc element object :test #'equal)))
    88              ((equal 'plist data-type)
    89               (get object element))
    90              (t
    91               (error "Does not handle this type of object. Implement your own get-val method.")))
    92            (if (listp object)
    93                (second (assoc element object :test #'equal))
    94                (error "Does not handle this type of object. Implement your own get-val method."))))))))
    95     
    96 
    97 (defgeneric (setf get-val) (new-value object element &optional data-type)
    98   (:documentation "Set the value in a object based on the supplied element name and possible type
    99 hints.")
   100   (:method (new-value object element &optional data-type)
   101     (typecase (or data-type object)
   102       (hash-table (setf (gethash element object) new-value))
   103       (standard-object (setf (slot-value object element) new-value))
   104       (t
   105        (if data-type
   106            (cond ((equal 'alist data-type)
   107                   (replace object (list (list element new-value))))
   108                  ((equal 'plist data-type)
   109                   ;;TODO: Implement this properly.
   110                   (get object element ))
   111                  (t
   112                   (error "Does not handle this type of object. Implement your own get-val method.")))
   113            (if (listp object)
   114                (replace object (list (list element new-value)))
   115                (error "Does not handle this type of object. Implement your own get-val method.")))))))