From: Andreas Gerler Date: Thu, 18 Jul 2024 13:15:08 +0000 (+0200) Subject: update closql X-Git-Url: http://git.bundesbrandschatzamt.de/?a=commitdiff_plain;h=c5568c594b74f424a02bf9e59b58741ce5941c8d;p=emacsconfig.git update closql Signed-off-by: Andreas Gerler --- diff --git a/elpa/closql-20230520.1519/closql-autoloads.el b/elpa/closql-20230520.1519/closql-autoloads.el deleted file mode 100644 index 3d07ad85..00000000 --- a/elpa/closql-20230520.1519/closql-autoloads.el +++ /dev/null @@ -1,26 +0,0 @@ -;;; closql-autoloads.el --- automatically extracted autoloads -*- lexical-binding: t -*- -;; -;;; Code: - -(add-to-list 'load-path (directory-file-name - (or (file-name-directory #$) (car load-path)))) - - -;;;### (autoloads nil "closql" "closql.el" (0 0 0 0)) -;;; Generated autoloads from closql.el - -(register-definition-prefixes "closql" '("closql-" "eieio-")) - -;;;*** - -;;;### (autoloads nil nil ("closql-pkg.el") (0 0 0 0)) - -;;;*** - -;; Local Variables: -;; version-control: never -;; no-byte-compile: t -;; no-update-autoloads: t -;; coding: utf-8 -;; End: -;;; closql-autoloads.el ends here diff --git a/elpa/closql-20230520.1519/closql-pkg.el b/elpa/closql-20230520.1519/closql-pkg.el deleted file mode 100644 index 27748e78..00000000 --- a/elpa/closql-20230520.1519/closql-pkg.el +++ /dev/null @@ -1,16 +0,0 @@ -(define-package "closql" "20230520.1519" "Store EIEIO objects using EmacSQL" - '((emacs "25.1") - (compat "29.1.3.4") - (emacsql "20230220")) - :commit "85ac7b8a894a4e259439d79eb6bd6f5129770905" :authors - '(("Jonas Bernoulli" . "jonas@bernoul.li")) - :maintainers - '(("Jonas Bernoulli" . "jonas@bernoul.li")) - :maintainer - '("Jonas Bernoulli" . "jonas@bernoul.li") - :keywords - '("extensions") - :url "https://github.com/emacscollective/closql") -;; Local Variables: -;; no-byte-compile: t -;; End: diff --git a/elpa/closql-20230520.1519/closql.el b/elpa/closql-20230520.1519/closql.el deleted file mode 100644 index 9584b2b9..00000000 --- a/elpa/closql-20230520.1519/closql.el +++ /dev/null @@ -1,682 +0,0 @@ -;;; closql.el --- Store EIEIO objects using EmacSQL -*- lexical-binding:t -*- - -;; Copyright (C) 2016-2023 Jonas Bernoulli - -;; Author: Jonas Bernoulli -;; Homepage: https://github.com/emacscollective/closql -;; Keywords: extensions - -;; Package-Requires: ( -;; (emacs "25.1") -;; (compat "29.1.3.4") -;; (emacsql "20230220")) - -;; SPDX-License-Identifier: GPL-3.0-or-later - -;; This file is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published -;; by the Free Software Foundation, either version 3 of the License, -;; or (at your option) any later version. -;; -;; This file is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. -;; -;; You should have received a copy of the GNU General Public License -;; along with this file. If not, see . - -;;; Commentary: - -;; Store uniform EIEIO objects in an EmacSQL database. SQLite is used -;; as backend. This library imposes some restrictions on what kind of -;; objects can be stored; it isn't intended to store arbitrary objects. -;; All objects have to share a common superclass and subclasses cannot -;; add any additional instance slots. - -;;; Code: - -(require 'compat) -(require 'eieio) -(require 'eieio-base) -(require 'emacsql) -(require 'emacsql-sqlite-common) - -(eval-when-compile (require 'subr-x)) - -(eval-and-compile - (unless (boundp 'eieio--unbound) ; New name since Emacs 28.1. - (defvaralias 'eieio--unbound 'eieio-unbound nil))) - -(eval-when-compile - (cl-pushnew 'connection eieio--known-slot-names)) - -(defmacro closql-with-transaction (db &rest body) - (declare (indent 1)) - `(emacsql-with-transaction (oref ,db connection) - ,@body)) - -;;; Objects - -(defclass closql-object () - ((closql-class-prefix :initform nil :allocation :class) - (closql-class-suffix :initform nil :allocation :class) - (closql-table :initform nil :allocation :class) - (closql-primary-key :initform nil :allocation :class) - (closql-foreign-key :initform nil :allocation :class) - (closql-order-by :initform nil :allocation :class) - (closql-database :initform nil :initarg :closql-database)) - :abstract t) - -(defun closql--closql-object-p (obj) - ;; Prevent a recursive load when the class object is autoloaded. - ;; See c1a9b816ec. Don't #'quote; doesn't exist in older releases. - (cl-letf (((symbol-function 'eieio--full-class-object) - #'eieio--class-object)) - (closql-object--eieio-childp obj))) - -;;;; Oref - -(defun eieio-oref--closql-oref (fn obj slot) - (if (closql--closql-object-p obj) - (closql-oref obj slot) - (funcall fn obj slot))) - -(advice-add 'eieio-oref :around #'eieio-oref--closql-oref) - -(defun closql--oref (obj slot) - (aref obj (eieio--slot-name-index (eieio--object-class obj) slot))) - -(defun closql-oref (obj slot) - (cl-check-type slot symbol) - (cl-check-type obj (or eieio-object class)) - (let* ((class (cond ((symbolp obj) - (error "eieio-oref called on a class: %s" obj) - (cond - ((fboundp 'eieio--full-class-object) ; Emacs >= 27 - (eieio--full-class-object obj)) - ((fboundp 'eieio-class-un-autoload) ; Emacs < 27 - (let ((c (cl--find-class obj))) - (if (eieio--class-p c) (eieio-class-un-autoload obj)) - c)))) - (t (eieio--object-class obj)))) - (c (eieio--slot-name-index class slot))) - (if (not c) - (if (setq c (eieio--class-slot-name-index class slot)) - (aref (eieio--class-class-allocation-values class) c) - (slot-missing obj slot 'oref)) - (cl-check-type obj eieio-object) - (let ((value (aref obj c)) - (class (closql--slot-class obj slot)) - (table (closql--slot-table obj slot)) - (db (closql--oref obj 'closql-database))) - (cond - (class - (aset obj c - (mapcar (lambda (row) - (closql--remake-instance class db row)) - (emacsql db (vconcat - [:select * :from $i1 - :where (= $i2 $s3)] - (vector - :order-by - (or (oref-default class closql-order-by) - [(asc $i4)]))) - (oref-default class closql-table) - (oref-default class closql-foreign-key) - (closql--oref - obj (oref-default obj closql-primary-key)) - (oref-default class closql-primary-key))))) - (table - (if (eq value eieio--unbound) - (let ((columns (closql--table-columns db table))) - (aset obj c - (mapcar - (if (length= columns 2) #'cadr #'cdr) - (emacsql db [:select * :from $i1 - :where (= $i2 $s3) - :order-by [(asc $i4)]] - table - (car columns) - (closql--oref - obj (oref-default obj closql-primary-key)) - (cadr columns))))) - value)) - (t - (eieio-barf-if-slot-unbound value obj slot 'oref))))))) - -;;;; Oset - -(defun eieio-oset--closql-oset (fn obj slot value) - (if (closql--closql-object-p obj) - (closql-oset obj slot value) - (funcall fn obj slot value))) - -(advice-add 'eieio-oset :around #'eieio-oset--closql-oset) - -(defun closql--oset (obj slot value) - (aset obj (eieio--slot-name-index (eieio--object-class obj) slot) value)) - -(defun closql-oset (obj slot value) - (cl-check-type obj eieio-object) - (cl-check-type slot symbol) - (let* ((class (eieio--object-class obj)) - (c (eieio--slot-name-index class slot))) - (if (not c) - (if (setq c (eieio--class-slot-name-index class slot)) - (progn (eieio--validate-class-slot-value class c value slot) - (aset (eieio--class-class-allocation-values class) c value)) - (slot-missing obj slot 'oset value)) - (eieio--validate-slot-value class c value slot) - (unless (eq slot 'closql-database) - (let ((db (closql--oref obj 'closql-database))) - (unless (or (not db) (eq db eieio--unbound)) - (closql--dset db obj slot value)))) - (aset obj c value)))) - -(defun closql--dset (db obj slot value) - (let* ((key (oref-default obj closql-primary-key)) - (id (closql--oref obj key)) - (class (closql--slot-class obj slot)) - (table (closql--slot-table obj slot))) - (cond - (class - (error "Not implemented for closql-class slots: oset")) - (table - (closql-with-transaction db - (let ((columns (closql--table-columns db table))) - ;; Caller might have modified value in place. - (closql--oset obj slot eieio--unbound) - (let ((list1 (closql-oref obj slot)) - (list2 value) - elt1 elt2) - (when (length= columns 2) - (setq list1 (mapcar #'list list1)) - (setq list2 (mapcar #'list list2))) - ;; `list2' may not be sorted at all and `list1' has to - ;; be sorted because Elisp and SQLite sort differently. - (setq list1 (cl-sort list1 #'string< :key #'car)) - (setq list2 (cl-sort list2 #'string< :key #'car)) - (while (progn (setq elt1 (car list1)) - (setq elt2 (car list2)) - (or elt1 elt2)) - (let ((key1 (car elt1)) - (key2 (car elt2))) - (cond - ((and elt1 (or (not elt2) (string< key1 key2))) - (apply #'emacsql db - (vconcat - [:delete-from $i1 :where] - (closql--where-equal (cons id elt1) 1)) - table - (cl-mapcan #'list columns (cons id elt1))) - (pop list1)) - ((string= key1 key2) - (unless (equal elt1 elt2) - (cl-mapc - (lambda (col val1 val2) - (unless (equal val1 val2) - (emacsql db [:update $i1 :set (= $i2 $s3) - :where (and (= $i4 $s5) (= $i6 $s7))] - table col val2 - (car columns) id - (cadr columns) key2))) - (cddr columns) - (cdr elt1) - (cdr elt2))) - (pop list1) - (pop list2)) - (t - (emacsql db [:insert-into $i1 :values $v2] - table (vconcat (cons id elt2))) - (pop list2))))))))) - (t - (emacsql db [:update $i1 :set (= $i2 $s3) :where (= $i4 $s5)] - (oref-default obj closql-table) - slot - (if (eq value eieio--unbound) 'eieio-unbound value) - key id))))) - -;;;; Slot Properties - -(defun closql--slot-class (obj slot) - (closql--slot-get obj slot :closql-class)) - -(defun closql--slot-table (obj slot) - (let ((tbl (closql--slot-get obj slot :closql-table))) - (and tbl (intern (string-replace - "-" "_" - (symbol-name (if (symbolp tbl) tbl (car tbl)))))))) - -(defun closql--slot-get (object-or-class slot prop) - (let ((s (car (cl-member slot - (eieio-class-slots - (cond ((eieio-object-p object-or-class) - (eieio--object-class object-or-class)) - ((eieio--class-p object-or-class) - object-or-class) - (t - (find-class object-or-class 'error)))) - :key #'cl--slot-descriptor-name)))) - (and s (cdr (assoc prop (cl--slot-descriptor-props s)))))) - -(defconst closql--slot-properties '(:closql-class :closql-table)) - -(defun eieio-defclass-internal--set-closql-slot-props - (cname _superclasses slots _options) - (let ((class (cl--find-class cname))) - (when (child-of-class-p class 'closql-object) - (pcase-dolist (`(,name . ,slot) slots) - (let ((slot-obj - (car (cl-member name - (cl-coerce (eieio--class-slots class) 'list) - :key (lambda (elt) (aref elt 1)))))) - (dolist (prop closql--slot-properties) - (let ((val (plist-get slot prop))) - (when val - (setf (alist-get prop (cl--slot-descriptor-props slot-obj)) - val))))))))) - -(advice-add 'eieio-defclass-internal :after - #'eieio-defclass-internal--set-closql-slot-props) - -(defun eieio--slot-override--set-closql-slot-props (old new _) - (dolist (prop closql--slot-properties) - (when (alist-get prop (cl--slot-descriptor-props new)) - (setf (alist-get prop (cl--slot-descriptor-props old)) - (alist-get prop (cl--slot-descriptor-props new)))))) - -(advice-add 'eieio--slot-override :after - #'eieio--slot-override--set-closql-slot-props) - -;;; Database - -(defclass closql-database (eieio-singleton) - ((name :initform nil :allocation :class) - (object-class :initform nil :allocation :class) - (file :initform nil :allocation :class) - (schemata :initform nil :allocation :class) - (version :initform nil :allocation :class) - (disabled :initform nil :allocation :class) - (connection :initform nil :initarg :connection)) - :abstract t) - -(cl-defmethod closql-db ((class (subclass closql-database)) - &optional livep connection-class) - (or (and-let* ((db (oref-default class singleton)) - (conn (and (not (eq db eieio--unbound)) - (oref db connection)))) - (and (emacsql-live-p conn) db)) - (and (not livep) - (let* ((file (closql--db-prepare-storage class)) - (connection-class (or connection-class - (emacsql-sqlite-default-connection))) - (conn (make-instance connection-class :file file)) - (db (make-instance class))) ; ignores slot arguments - (oset db connection conn) - (when (and (slot-boundp conn 'handle) - (processp (oref conn handle))) - (set-process-query-on-exit-flag (oref conn handle) nil)) - (emacsql conn [:pragma (= foreign-keys on)]) - (if (not (emacsql-sqlite-list-tables db)) - (closql--db-create-schema db) - (let ((code-version (oref-default db version)) - (data-version (closql--db-get-version db))) - (cond - ((< code-version data-version) - (message - "Please update %s package (database schema version %s < %s)" - (oref-default db name) code-version data-version) - (oset-default db disabled t) - (emacsql-close db) - (setq db nil)) - ((closql--db-update-schema db))))) - db)))) - -(cl-defmethod closql--db-prepare-storage ((class (subclass closql-database))) - (when-let ((file (oref-default class file))) - (when (symbolp file) - (setq file (symbol-value file))) - (make-directory (file-name-directory file) t) - file)) - -(cl-defmethod closql--db-create-schema ((db closql-database)) - (closql-with-transaction db - (pcase-dolist (`(,table . ,schema) - (symbol-value (oref-default db schemata))) - (emacsql db [:create-table $i1 $S2] table schema)) - (closql--db-set-version db (oref-default db version)))) - -(cl-defmethod closql--db-update-schema ((db closql-database)) - (let ((code-version (oref-default db version)) - (data-version (closql--db-get-version db))) - (when (< data-version code-version) - (oset-default db disabled t) - (emacsql-close db) - (error "Please update %s database (schema version %s < %s)" - (oref-default db name) data-version code-version)))) - -(cl-defmethod emacsql-live-p ((db closql-database)) - (and-let* ((conn (oref db connection))) - (emacsql-live-p conn))) - -(cl-defmethod emacsql-enable-debugging ((db closql-database)) - (emacsql-enable-debugging (oref db connection))) - -(cl-defmethod emacsql-close ((db closql-database)) - (emacsql-close (oref db connection)) - (oset db connection nil)) - -(cl-defmethod emacsql ((db closql-database) sql &rest args) - (mapcar #'closql--extern-unbound - (apply #'emacsql (oref db connection) sql - (mapcar (lambda (arg) - (if (stringp arg) - (let ((copy (copy-sequence arg))) - (set-text-properties 0 (length copy) nil copy) - copy) - arg)) - args)))) - -(cl-defmethod closql-insert ((db closql-database) obj &optional replace) - (closql--oset obj 'closql-database db) - (let (alist) - (dolist (slot (eieio-class-slots (eieio--object-class obj))) - (setq slot (cl--slot-descriptor-name slot)) - (let ((table (closql--slot-table obj slot))) - (when table - (push (cons slot (closql-oref obj slot)) alist) - (closql--oset obj slot eieio--unbound)))) - (closql-with-transaction db - (emacsql db - (if replace - [:insert-or-replace-into $i1 :values $v2] - [:insert-into $i1 :values $v2]) - (oref-default obj closql-table) - (pcase-let ((`(,class ,_db . ,values) - (closql--intern-unbound - (closql--coerce obj 'list)))) - (vconcat (cons (closql--abbrev-class - (if (eieio--class-p class) - (eieio--class-name class) - class)) - values)))) - (pcase-dolist (`(,slot . ,value) alist) - (closql--dset db obj slot value)))) - obj) - -(cl-defmethod closql-delete ((obj closql-object)) - (let ((key (oref-default obj closql-primary-key))) - (emacsql (closql--oref obj 'closql-database) - [:delete-from $i1 :where (= $i2 $s3)] - (oref-default obj closql-table) - key - (closql--oref obj key)))) - -(cl-defmethod closql-reload ((obj closql-object)) - (or (closql-get (closql--oref obj 'closql-database) - (closql--oref obj (oref-default obj closql-primary-key)) - (eieio-object-class obj)) - (error "Cannot reload object"))) - -(cl-defmethod closql-get ((db closql-database) ident &optional class resolve) - (unless class - (setq class (oref-default db object-class))) - (and-let* ((row (car (emacsql db [:select * :from $i1 - :where (= $i2 $s3)] - (oref-default class closql-table) - (oref-default class closql-primary-key) - ident)))) - (closql--remake-instance class db row resolve))) - -(cl-defmethod closql-query ((db closql-database) &optional select pred class) - (if select - (let ((value (closql-select db select pred class))) - (if (and select (symbolp select)) - (mapcar #'car value) - value)) - (closql-entries db pred class))) - -(cl-defmethod closql-entries ((db closql-database) &optional pred class) - (unless class - (setq class (oref-default db object-class))) - (mapcar (lambda (row) - (closql--remake-instance class db row)) - (closql-select db '* pred class))) - -(cl-defmethod closql-select ((db closql-database) select &optional pred class) - (unless class - (setq class (oref-default db object-class))) - (emacsql db - (vconcat [:select $i1 :from $i2] - (and pred - [:where class :in $v3]) - (if-let ((order (oref-default class closql-order-by))) - (vector :order-by order) - [:order-by [(asc $i4)]])) - select - (oref-default class closql-table) - (and pred (closql-where-class-in pred db)) - (oref-default class closql-primary-key))) - -(defun closql--table-columns (db table &optional prefixed) - (mapcar (if prefixed - (lambda (col) (intern (format "%s:%s" table (cadr col)))) - #'cadr) - (emacsql db [:pragma (funcall table-info $i1)] table))) - -(defun closql--db-get-version (db) - (caar (emacsql db [:pragma user-version]))) - -(defun closql--db-set-version (db version) - (cl-assert (integerp version)) - (emacsql db [:pragma (= user-version $s1)] version)) - -;;; Object/Row Conversion - -(cl-defmethod closql--remake-instance ((class (subclass closql-object)) - db row &optional resolve) - (pcase-let ((`(,abbrev . ,values) - (closql--extern-unbound row))) - (let* ((class-sym (closql--expand-abbrev class abbrev)) - (this (if (fboundp 'record) - (let* ((class-obj (eieio--class-object class-sym)) - (obj (copy-sequence - (eieio--class-default-object-cache - class-obj)))) - (setq values (apply #'vector (cons db values))) - (dotimes (i (length (eieio--class-slots class-obj))) - (aset obj (1+ i) (aref values i))) - obj) - (vconcat (list class-sym db) values)))) - (when resolve - (closql--resolve-slots this)) - this))) - -(cl-defmethod closql--resolve-slots ((obj closql-object)) - (dolist (slot (eieio-class-slots (eieio--object-class obj))) - (setq slot (cl--slot-descriptor-name slot)) - (when (and (not (slot-boundp obj slot)) - (or (closql--slot-class obj slot) - (closql--slot-table obj slot))) - (closql--oset obj slot (closql-oref obj slot))))) - -(defun closql--intern-unbound (row) - (mapcar (lambda (elt) - (if (eq elt eieio--unbound) 'eieio-unbound elt)) - row)) - -(defun closql--extern-unbound (row) - (mapcar (lambda (elt) - (if (eq elt 'eieio-unbound) eieio--unbound elt)) - row)) - -(defun closql--coerce (object type) - (cl-coerce (if (and (fboundp 'recordp) - (recordp object)) - (let* ((len (length object)) - (vec (make-vector len -1))) - (dotimes (i len) - (aset vec i (aref object i))) - vec) - object) - type)) - -(cl-defmethod closql--abbrev-class ((class-tag symbol)) - ;; This other method is only used for old-school eieio-class-tag--*. - (closql--abbrev-class (intern (substring (symbol-name class-tag) 17)))) - -(cl-defmethod closql--abbrev-class ((class (subclass closql-object))) - (let ((name (symbol-name class)) - (prefix (oref-default class closql-class-prefix)) - (suffix (oref-default class closql-class-suffix))) - (intern (substring name - (if prefix (length prefix) 0) - (if suffix (- (length suffix)) nil))))) - -(cl-defmethod closql--expand-abbrev ((class (subclass closql-object)) abbrev) - (intern (concat (and (not (fboundp 'record)) "eieio-class-tag--") - (oref-default class closql-class-prefix) - (symbol-name abbrev) - (oref-default class closql-class-suffix)))) - -(defun closql--where-equal (value offset) - (vector - (cons 'and - (mapcar (lambda (v) - (if v - (list '= - (intern (format "$i%i" (cl-incf offset))) - (intern (format "$s%i" (cl-incf offset)))) - (list 'isnull - (intern (format "$i%i" (1- (cl-incf offset 2))))))) - value)))) - -(defun closql-where-class-in (args &optional db) - (when (symbolp args) - (setq args (list args))) - (cond - ((vectorp args) - (unless db - (error "closql-where-class-in: DB cannot be nil if ARGS is a vector")) - (let ((class (oref-default db object-class)) - (abbrevs nil)) - (mapc (lambda (arg) - (let ((str (symbol-name arg))) - (unless (string-match "\\`\\(!\\)?\\([^*]+\\)\\(\\*\\)?\\'" str) - (error "closql-where-class-in: invalid type: %s" arg)) - (let* ((exclude (match-beginning 1)) - (a (intern (match-string 2 str))) - (a (cond ((match-beginning 3) - (closql--list-subabbrevs - (closql--expand-abbrev class a))) - ((not (class-abstract-p - (closql--expand-abbrev class a))) - (list a))))) - (setq abbrevs - (if exclude - (cl-set-difference abbrevs a) - (nconc abbrevs a)))))) - args) - (vconcat abbrevs))) - ((vconcat - (mapcar #'closql--abbrev-class - (cl-mapcan (lambda (sym) - (let ((str (symbol-name sym))) - (cond ((string-suffix-p "--eieio-childp" str) - (closql--list-subclasses - (intern (substring str 0 -14)) nil)) - ((string-suffix-p "-p" str) - (list (intern (substring str 0 -2)))) - ((list sym))))) - args)))))) - -(defun closql--list-subclasses (class &optional result) - (unless (class-abstract-p class) - (cl-pushnew class result)) - (dolist (child (eieio--class-children (cl--find-class class))) - (setq result (closql--list-subclasses child result))) - result) - -(cl-defmethod closql--list-subabbrevs ((class (subclass closql-object)) - &optional wildcards) - (cl-labels - ((types (class) - (let ((children (eieio--class-children (cl--find-class class))) - ;; An abstract base-class may violate its own naming rules. - (abbrev (ignore-errors (closql--abbrev-class class)))) - (nconc (and (not (class-abstract-p class)) (list abbrev)) - (and wildcards children - (list (if abbrev (intern (format "%s*" abbrev)) '*))) - (cl-mapcan #'types children))))) - (sort (types class) #'string<))) - -(cl-defmethod closql--set-object-class ((db closql-database) obj class) - (let* ((table (oref-default obj closql-table)) - (key (oref-default obj closql-primary-key)) - (id (closql--oref obj key))) - (aset obj 0 - (if (fboundp 'record) - (aref (copy-sequence - (eieio--class-default-object-cache - (eieio--class-object class))) - 0) - (intern (format "eieio-class-tag--%s" class)))) - (emacsql db [:update $i1 :set (= class $s2) :where (= $i3 $s4)] - table - (closql--abbrev-class class) - key id))) - -;;; Experimental - -(defun closql--iref (obj slot) - (pcase-let* - ((db (closql--oref obj 'closql-database)) - (`(,d-table ,i-table) - (closql--slot-tables obj slot)) - (d-cols (closql--table-columns db d-table)) - (i-cols (closql--table-columns db i-table)) - (obj-id (closql--oref obj (oref-default obj closql-primary-key)))) - (emacsql db (format "\ -SELECT DISTINCT %s FROM %s AS d, %s AS i -WHERE d.%s = i.%s AND d.%s = '%S';" - (mapconcat (apply-partially #'format "i.%s") - (cddr i-cols) ", ") - d-table - i-table - (cadr d-cols) - (cadr i-cols) - (car d-cols) - obj-id)))) - -(defun closql--slot-tables (obj slot) - (let ((tbls (closql--slot-get obj slot :closql-table))) - (unless (listp tbls) - (error "%s isn't an indirect slot" slot)) - (pcase-let ((`(,d-tbl ,i-tbl) tbls)) - (list (intern (string-replace "-" "_" (symbol-name d-tbl))) - (intern (string-replace "-" "_" (symbol-name i-tbl))))))) - -;;; Utilities - -(defun closql-format (object string &rest slots) - "Format a string out of a format STRING and an OBJECT's SLOTS. - -STRING is a format-string like for `format'. OBJECT is an Eieio -object and SLOTS are slots of that object, their values are used -like `format' uses its OBJECTS arguments (which are unrelated to -this function's OBJECT argument, they just have similar names). - -While this function does not have much to do with the purpose of -`closql', it is being defined here anyway because Eieio does not -define a similar function under a more appropriate name such as -`eieio-format'." - (apply #'format string - (mapcar (lambda (slot) (eieio-oref object slot)) slots))) - -;;; _ -(provide 'closql) -;; Local Variables: -;; indent-tabs-mode: nil -;; End: -;;; closql.el ends here diff --git a/elpa/closql-20240415.1534/closql-autoloads.el b/elpa/closql-20240415.1534/closql-autoloads.el new file mode 100644 index 00000000..b458de91 --- /dev/null +++ b/elpa/closql-20240415.1534/closql-autoloads.el @@ -0,0 +1,28 @@ +;;; closql-autoloads.el --- automatically extracted autoloads (do not edit) -*- lexical-binding: t -*- +;; Generated by the `loaddefs-generate' function. + +;; This file is part of GNU Emacs. + +;;; Code: + +(add-to-list 'load-path (or (and load-file-name (directory-file-name (file-name-directory load-file-name))) (car load-path))) + + + +;;; Generated autoloads from closql.el + +(register-definition-prefixes "closql" '("closql-" "eieio-")) + +;;; End of scraped data + +(provide 'closql-autoloads) + +;; Local Variables: +;; version-control: never +;; no-byte-compile: t +;; no-update-autoloads: t +;; no-native-compile: t +;; coding: utf-8-emacs-unix +;; End: + +;;; closql-autoloads.el ends here diff --git a/elpa/closql-20240415.1534/closql-pkg.el b/elpa/closql-20240415.1534/closql-pkg.el new file mode 100644 index 00000000..6b39bf2e --- /dev/null +++ b/elpa/closql-20240415.1534/closql-pkg.el @@ -0,0 +1,16 @@ +(define-package "closql" "20240415.1534" "Store EIEIO objects using EmacSQL" + '((emacs "25.1") + (compat "29.1.4.5") + (emacsql "20240124")) + :commit "2bff36edd28c9a0d0c25b545b3837fa874376cc5" :authors + '(("Jonas Bernoulli" . "emacs.closql@jonas.bernoulli.dev")) + :maintainers + '(("Jonas Bernoulli" . "emacs.closql@jonas.bernoulli.dev")) + :maintainer + '("Jonas Bernoulli" . "emacs.closql@jonas.bernoulli.dev") + :keywords + '("extensions") + :url "https://github.com/emacscollective/closql") +;; Local Variables: +;; no-byte-compile: t +;; End: diff --git a/elpa/closql-20240415.1534/closql.el b/elpa/closql-20240415.1534/closql.el new file mode 100644 index 00000000..92bedf57 --- /dev/null +++ b/elpa/closql-20240415.1534/closql.el @@ -0,0 +1,661 @@ +;;; closql.el --- Store EIEIO objects using EmacSQL -*- lexical-binding:t -*- + +;; Copyright (C) 2016-2024 Jonas Bernoulli + +;; Author: Jonas Bernoulli +;; Homepage: https://github.com/emacscollective/closql +;; Keywords: extensions + +;; Package-Requires: ( +;; (emacs "25.1") +;; (compat "29.1.4.5") +;; (emacsql "20240124")) + +;; SPDX-License-Identifier: GPL-3.0-or-later + +;; This file is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published +;; by the Free Software Foundation, either version 3 of the License, +;; or (at your option) any later version. +;; +;; This file is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this file. If not, see . + +;;; Commentary: + +;; Store uniform EIEIO objects in an EmacSQL database. SQLite is used +;; as backend. This library imposes some restrictions on what kind of +;; objects can be stored; it isn't intended to store arbitrary objects. +;; All objects have to share a common superclass and subclasses cannot +;; add any additional instance slots. + +;;; Code: + +(require 'compat) +(require 'eieio) +(require 'eieio-base) +(require 'emacsql) +(require 'emacsql-sqlite-common) + +(eval-when-compile (require 'subr-x)) + +(eval-and-compile + (unless (boundp 'eieio--unbound) ; New name since Emacs 28.1. + (defvaralias 'eieio--unbound 'eieio-unbound nil))) + +(eval-when-compile + (cl-pushnew 'connection eieio--known-slot-names)) + +(defmacro closql-with-transaction (db &rest body) + (declare (indent 1)) + `(emacsql-with-transaction (oref ,db connection) + ,@body)) + +;;; Objects + +(defclass closql-object () + ((closql-class-prefix :initform nil :allocation :class) + (closql-class-suffix :initform nil :allocation :class) + (closql-table :initform nil :allocation :class) + (closql-primary-key :initform nil :allocation :class) + (closql-foreign-key :initform nil :allocation :class) + (closql-order-by :initform nil :allocation :class) + (closql-database :initform nil :initarg :closql-database)) + :abstract t) + +(defun closql--closql-object-p (obj) + ;; Prevent a recursive load when the class object is autoloaded. + ;; See c1a9b816ec. Don't #'quote; doesn't exist in older releases. + (cl-letf (((symbol-function 'eieio--full-class-object) + #'eieio--class-object)) + (closql-object--eieio-childp obj))) + +;;;; Oref + +(defun eieio-oref--closql-oref (fn obj slot) + (if (closql--closql-object-p obj) + (closql-oref obj slot) + (funcall fn obj slot))) + +(advice-add 'eieio-oref :around #'eieio-oref--closql-oref) + +(defun closql--oref (obj slot) + (aref obj (eieio--slot-name-index (eieio--object-class obj) slot))) + +(defun closql-oref (obj slot) + (cl-check-type slot symbol) + (let* ((class (eieio--object-class obj)) + (c (eieio--slot-name-index class slot))) + (if (not c) + (if (setq c (eieio--class-slot-name-index class slot)) + (aref (eieio--class-class-allocation-values class) c) + (slot-missing obj slot 'oref)) + (let ((value (aref obj c)) + (db (closql--oref obj 'closql-database)) + class table) + (cond + ((not (eq value eieio--unbound)) value) + ((setq class (closql--slot-class obj slot)) + (aset obj c + (mapcar (lambda (row) (closql--remake-instance class db row)) + (emacsql db (vconcat + [:select * :from $i1 + :where (= $i2 $s3)] + (vector + :order-by + (or (oref-default class closql-order-by) + [(asc $i4)]))) + (oref-default class closql-table) + (oref-default class closql-foreign-key) + (closql--oref + obj (oref-default obj closql-primary-key)) + (oref-default class closql-primary-key))))) + ((setq table (closql--slot-table obj slot)) + (let ((columns (closql--table-columns db table))) + (aset obj c + (mapcar (if (length= columns 2) #'cadr #'cdr) + (emacsql db [:select * :from $i1 + :where (= $i2 $s3) + :order-by [(asc $i4)]] + table + (car columns) + (closql--oref + obj (oref-default obj closql-primary-key)) + (cadr columns)))))) + ((slot-unbound obj (eieio--object-class obj) slot 'oref))))))) + +;;;; Oset + +(defun eieio-oset--closql-oset (fn obj slot value) + (if (closql--closql-object-p obj) + (closql-oset obj slot value) + (funcall fn obj slot value))) + +(advice-add 'eieio-oset :around #'eieio-oset--closql-oset) + +(defun closql--oset (obj slot value) + (aset obj (eieio--slot-name-index (eieio--object-class obj) slot) value)) + +(defun closql-oset (obj slot value) + (cl-check-type slot symbol) + (let* ((class (eieio--object-class obj)) + (c (eieio--slot-name-index class slot))) + (if (not c) + (if (setq c (eieio--class-slot-name-index class slot)) + (progn (eieio--validate-class-slot-value class c value slot) + (aset (eieio--class-class-allocation-values class) c value)) + (slot-missing obj slot 'oset value)) + (eieio--validate-slot-value class c value slot) + (unless (eq slot 'closql-database) + (let ((db (closql--oref obj 'closql-database))) + (unless (or (not db) (eq db eieio--unbound)) + (closql--dset db obj slot value)))) + (aset obj c value)))) + +(defun closql--dset (db obj slot value) + (let* ((key (oref-default obj closql-primary-key)) + (id (closql--oref obj key)) + (class (closql--slot-class obj slot)) + (table (closql--slot-table obj slot))) + (cond + (class + (error "Not implemented for closql-class slots: oset")) + (table + (closql-with-transaction db + (let ((columns (closql--table-columns db table))) + ;; Caller might have modified value in place. + (closql--oset obj slot eieio--unbound) + (let ((list1 (closql-oref obj slot)) + (list2 value) + elt1 elt2) + (when (length= columns 2) + (setq list1 (mapcar #'list list1)) + (setq list2 (mapcar #'list list2))) + ;; `list2' may not be sorted at all and `list1' has to + ;; be sorted because Elisp and SQLite sort differently. + (setq list1 (cl-sort list1 #'string< :key #'car)) + (setq list2 (cl-sort list2 #'string< :key #'car)) + (while (progn (setq elt1 (car list1)) + (setq elt2 (car list2)) + (or elt1 elt2)) + (let ((key1 (car elt1)) + (key2 (car elt2))) + (cond + ((and elt1 (or (not elt2) (string< key1 key2))) + (apply #'emacsql db + (vconcat + [:delete-from $i1 :where] + (closql--where-equal (cons id elt1) 1)) + table + (cl-mapcan #'list columns (cons id elt1))) + (pop list1)) + ((string= key1 key2) + (unless (equal elt1 elt2) + (cl-mapc + (lambda (col val1 val2) + (unless (equal val1 val2) + (emacsql db [:update $i1 :set (= $i2 $s3) + :where (and (= $i4 $s5) (= $i6 $s7))] + table col val2 + (car columns) id + (cadr columns) key2))) + (cddr columns) + (cdr elt1) + (cdr elt2))) + (pop list1) + (pop list2)) + (t + (emacsql db [:insert-into $i1 :values $v2] + table (vconcat (cons id elt2))) + (pop list2))))))))) + (t + (emacsql db [:update $i1 :set (= $i2 $s3) :where (= $i4 $s5)] + (oref-default obj closql-table) + slot + (if (eq value eieio--unbound) 'eieio-unbound value) + key id))))) + +;;;; Slot Properties + +(defun closql--slot-class (obj slot) + (closql--slot-get obj slot :closql-class)) + +(defun closql--slot-table (obj slot) + (let ((tbl (closql--slot-get obj slot :closql-table))) + (and tbl (intern (string-replace + "-" "_" + (symbol-name (if (symbolp tbl) tbl (car tbl)))))))) + +(defun closql--slot-get (object-or-class slot prop) + (let ((s (car (cl-member slot + (eieio-class-slots + (cond ((eieio-object-p object-or-class) + (eieio--object-class object-or-class)) + ((eieio--class-p object-or-class) + object-or-class) + (t + (find-class object-or-class 'error)))) + :key #'cl--slot-descriptor-name)))) + (and s (cdr (assoc prop (cl--slot-descriptor-props s)))))) + +(defconst closql--slot-properties '(:closql-class :closql-table)) + +(defun eieio-defclass-internal--set-closql-slot-props + (cname _superclasses slots _options) + (let ((class (cl--find-class cname))) + (when (child-of-class-p class 'closql-object) + (pcase-dolist (`(,name . ,slot) slots) + (let ((slot-obj + (car (cl-member name + (cl-coerce (eieio--class-slots class) 'list) + :key (lambda (elt) (aref elt 1)))))) + (dolist (prop closql--slot-properties) + (let ((val (plist-get slot prop))) + (when val + (setf (alist-get prop (cl--slot-descriptor-props slot-obj)) + val))))))))) + +(advice-add 'eieio-defclass-internal :after + #'eieio-defclass-internal--set-closql-slot-props) + +(defun eieio--slot-override--set-closql-slot-props (old new _) + (dolist (prop closql--slot-properties) + (when (alist-get prop (cl--slot-descriptor-props new)) + (setf (alist-get prop (cl--slot-descriptor-props old)) + (alist-get prop (cl--slot-descriptor-props new)))))) + +(advice-add 'eieio--slot-override :after + #'eieio--slot-override--set-closql-slot-props) + +;;; Database + +(defclass closql-database (eieio-singleton) + ((name :initform nil :allocation :class) + (object-class :initform nil :allocation :class) + (file :initform nil :allocation :class) + (schemata :initform nil :allocation :class) + (version :initform nil :allocation :class) + (disabled :initform nil :allocation :class) + (connection :initform nil :initarg :connection)) + :abstract t) + +(cl-defmethod closql-db ((class (subclass closql-database)) + &optional livep connection-class) + (or (and-let* ((db (oref-default class singleton)) + (conn (and (not (eq db eieio--unbound)) + (oref db connection)))) + (and (emacsql-live-p conn) db)) + (and (not livep) + (let* ((file (closql--db-prepare-storage class)) + (connection-class (or connection-class + (emacsql-sqlite-default-connection))) + (conn (make-instance connection-class :file file)) + (db (make-instance class))) ; ignores slot arguments + (oset db connection conn) + (when (and (slot-boundp conn 'handle) + (processp (oref conn handle))) + (set-process-query-on-exit-flag (oref conn handle) nil)) + (emacsql conn [:pragma (= foreign-keys on)]) + (if (not (emacsql-sqlite-list-tables db)) + (closql--db-create-schema db) + (let ((code-version (oref-default db version)) + (data-version (closql--db-get-version db))) + (cond + ((< code-version data-version) + (message + "Please update %s package (database schema version %s < %s)" + (oref-default db name) code-version data-version) + (oset-default class disabled t) + (emacsql-close db) + (setq db nil)) + ((closql--db-update-schema db))))) + db)))) + +(cl-defmethod closql--db-prepare-storage ((class (subclass closql-database))) + (when-let ((file (oref-default class file))) + (when (symbolp file) + (setq file (symbol-value file))) + (make-directory (file-name-directory file) t) + file)) + +(cl-defmethod closql--db-create-schema ((db closql-database)) + (closql-with-transaction db + (pcase-dolist (`(,table . ,schema) + (symbol-value (oref-default db schemata))) + (emacsql db [:create-table $i1 $S2] table schema)) + (closql--db-set-version db (oref-default db version)))) + +(cl-defmethod closql--db-update-schema ((db closql-database)) + (let ((code-version (oref-default db version)) + (data-version (closql--db-get-version db))) + (when (< data-version code-version) + (oset-default db disabled t) + (emacsql-close db) + (error "Please update %s database (schema version %s < %s)" + (oref-default db name) data-version code-version)))) + +(cl-defmethod emacsql-live-p ((db closql-database)) + (and-let* ((conn (oref db connection))) + (emacsql-live-p conn))) + +(cl-defmethod emacsql-enable-debugging ((db closql-database)) + (emacsql-enable-debugging (oref db connection))) + +(cl-defmethod emacsql-close ((db closql-database)) + (emacsql-close (oref db connection)) + (oset db connection nil)) + +(cl-defmethod emacsql ((db closql-database) sql &rest args) + (mapcar #'closql--extern-unbound + (apply #'emacsql (oref db connection) sql + (mapcar (lambda (arg) + (if (stringp arg) + (let ((copy (copy-sequence arg))) + (set-text-properties 0 (length copy) nil copy) + copy) + arg)) + args)))) + +(cl-defmethod closql-insert ((db closql-database) obj &optional replace) + (closql--oset obj 'closql-database db) + (let (alist) + (dolist (slot (eieio-class-slots (eieio--object-class obj))) + (setq slot (cl--slot-descriptor-name slot)) + (let ((table (closql--slot-table obj slot))) + (when table + (push (cons slot (closql-oref obj slot)) alist) + (closql--oset obj slot eieio--unbound)))) + (closql-with-transaction db + (emacsql db + (if replace + [:insert-or-replace-into $i1 :values $v2] + [:insert-into $i1 :values $v2]) + (oref-default obj closql-table) + (pcase-let ((`(,class ,_db . ,values) + (closql--intern-unbound + (closql--coerce obj 'list)))) + (vconcat (cons (closql--abbrev-class + (if (eieio--class-p class) + (eieio--class-name class) + class)) + values)))) + (pcase-dolist (`(,slot . ,value) alist) + (closql--dset db obj slot value)))) + obj) + +(cl-defmethod closql-delete ((obj closql-object)) + (let ((key (oref-default obj closql-primary-key))) + (emacsql (closql--oref obj 'closql-database) + [:delete-from $i1 :where (= $i2 $s3)] + (oref-default obj closql-table) + key + (closql--oref obj key)))) + +(cl-defmethod closql-reload ((obj closql-object)) + (or (closql-get (closql--oref obj 'closql-database) + (closql--oref obj (oref-default obj closql-primary-key)) + (eieio-object-class obj)) + (error "Cannot reload object"))) + +(cl-defmethod closql-get ((db closql-database) ident &optional class resolve) + (unless class + (setq class (oref-default db object-class))) + (and-let* ((row (car (emacsql db [:select * :from $i1 + :where (= $i2 $s3)] + (oref-default class closql-table) + (oref-default class closql-primary-key) + ident)))) + (closql--remake-instance class db row resolve))) + +(cl-defmethod closql-query ((db closql-database) &optional select pred class) + (if select + (let ((value (closql-select db select pred class))) + (if (and select (symbolp select)) + (mapcar #'car value) + value)) + (closql-entries db pred class))) + +(cl-defmethod closql-entries ((db closql-database) &optional pred class) + (unless class + (setq class (oref-default db object-class))) + (mapcar (lambda (row) + (closql--remake-instance class db row)) + (closql-select db '* pred class))) + +(cl-defmethod closql-select ((db closql-database) select &optional pred class) + (unless class + (setq class (oref-default db object-class))) + (emacsql db + (vconcat [:select $i1 :from $i2] + (and pred + [:where class :in $v3]) + (if-let ((order (oref-default class closql-order-by))) + (vector :order-by order) + [:order-by [(asc $i4)]])) + select + (oref-default class closql-table) + (and pred (closql-where-class-in pred db)) + (oref-default class closql-primary-key))) + +(defun closql--table-columns (db table &optional prefixed) + (mapcar (if prefixed + (let ((prefix (if (stringp prefixed) prefixed table))) + (lambda (col) (intern (format "%s:%s" prefix (cadr col))))) + #'cadr) + (emacsql db [:pragma (funcall table-info $i1)] table))) + +(defun closql--db-get-version (db) + (caar (emacsql db [:pragma user-version]))) + +(defun closql--db-set-version (db version) + (cl-assert (integerp version)) + (emacsql db [:pragma (= user-version $s1)] version)) + +;;; Object/Row Conversion + +(cl-defmethod closql--remake-instance ((class (subclass closql-object)) + db row &optional resolve) + (pcase-let ((`(,abbrev . ,values) + (closql--extern-unbound row))) + (let* ((class-sym (closql--expand-abbrev class abbrev)) + (this (if (fboundp 'record) + (let* ((class-obj (eieio--class-object class-sym)) + (obj (copy-sequence + (eieio--class-default-object-cache + class-obj)))) + (setq values (apply #'vector (cons db values))) + (dotimes (i (length (eieio--class-slots class-obj))) + (aset obj (1+ i) (aref values i))) + obj) + (vconcat (list class-sym db) values)))) + (when resolve + (closql--resolve-slots this)) + this))) + +(cl-defmethod closql--resolve-slots ((obj closql-object)) + (dolist (slot (eieio-class-slots (eieio--object-class obj))) + (setq slot (cl--slot-descriptor-name slot)) + (when (and (not (slot-boundp obj slot)) + (or (closql--slot-class obj slot) + (closql--slot-table obj slot))) + (closql--oset obj slot (closql-oref obj slot))))) + +(defun closql--intern-unbound (row) + (mapcar (lambda (elt) + (if (eq elt eieio--unbound) 'eieio-unbound elt)) + row)) + +(defun closql--extern-unbound (row) + (mapcar (lambda (elt) + (if (eq elt 'eieio-unbound) eieio--unbound elt)) + row)) + +(defun closql--coerce (object type) + (cl-coerce (if (and (fboundp 'recordp) + (recordp object)) + (let* ((len (length object)) + (vec (make-vector len -1))) + (dotimes (i len) + (aset vec i (aref object i))) + vec) + object) + type)) + +(cl-defmethod closql--abbrev-class ((class-tag symbol)) + ;; This other method is only used for old-school eieio-class-tag--*. + (closql--abbrev-class (intern (substring (symbol-name class-tag) 17)))) + +(cl-defmethod closql--abbrev-class ((class (subclass closql-object))) + (let ((name (symbol-name class)) + (prefix (oref-default class closql-class-prefix)) + (suffix (oref-default class closql-class-suffix))) + (intern (substring name + (if prefix (length prefix) 0) + (if suffix (- (length suffix)) nil))))) + +(cl-defmethod closql--expand-abbrev ((class (subclass closql-object)) abbrev) + (intern (concat (and (not (fboundp 'record)) "eieio-class-tag--") + (oref-default class closql-class-prefix) + (symbol-name abbrev) + (oref-default class closql-class-suffix)))) + +(defun closql--where-equal (value offset) + (vector + (cons 'and + (mapcar (lambda (v) + (if v + (list '= + (intern (format "$i%i" (cl-incf offset))) + (intern (format "$s%i" (cl-incf offset)))) + (list 'isnull + (intern (format "$i%i" (1- (cl-incf offset 2))))))) + value)))) + +(defun closql-where-class-in (args &optional db) + (when (symbolp args) + (setq args (list args))) + (cond + ((vectorp args) + (unless db + (error "closql-where-class-in: DB cannot be nil if ARGS is a vector")) + (let ((class (oref-default db object-class)) + (abbrevs nil)) + (mapc (lambda (arg) + (let ((str (symbol-name arg))) + (unless (string-match "\\`\\(!\\)?\\([^*]+\\)\\(\\*\\)?\\'" str) + (error "closql-where-class-in: invalid type: %s" arg)) + (let* ((exclude (match-beginning 1)) + (a (intern (match-string 2 str))) + (a (cond ((match-beginning 3) + (closql--list-subabbrevs + (closql--expand-abbrev class a))) + ((not (class-abstract-p + (closql--expand-abbrev class a))) + (list a))))) + (setq abbrevs + (if exclude + (cl-set-difference abbrevs a) + (nconc abbrevs a)))))) + args) + (vconcat abbrevs))) + ((vconcat + (mapcar #'closql--abbrev-class + (cl-mapcan (lambda (sym) + (let ((str (symbol-name sym))) + (cond ((string-suffix-p "--eieio-childp" str) + (closql--list-subclasses + (intern (substring str 0 -14)) nil)) + ((string-suffix-p "-p" str) + (list (intern (substring str 0 -2)))) + ((list sym))))) + args)))))) + +(defun closql--list-subclasses (class &optional result) + (unless (class-abstract-p class) + (cl-pushnew class result)) + (dolist (child (eieio--class-children (cl--find-class class))) + (setq result (closql--list-subclasses child result))) + result) + +(cl-defmethod closql--list-subabbrevs ((class (subclass closql-object)) + &optional wildcards) + (cl-labels + ((types (class) + (let ((children (eieio--class-children (cl--find-class class))) + ;; An abstract base-class may violate its own naming rules. + (abbrev (ignore-errors (closql--abbrev-class class)))) + (nconc (and (not (class-abstract-p class)) (list abbrev)) + (and wildcards children + (list (if abbrev (intern (format "%s*" abbrev)) '*))) + (cl-mapcan #'types children))))) + (sort (types class) #'string<))) + +(cl-defmethod closql--set-object-class ((db closql-database) obj class) + (let* ((table (oref-default obj closql-table)) + (key (oref-default obj closql-primary-key)) + (id (closql--oref obj key))) + (aset obj 0 + (if (fboundp 'record) + (aref (copy-sequence + (eieio--class-default-object-cache + (eieio--class-object class))) + 0) + (intern (format "eieio-class-tag--%s" class)))) + (emacsql db [:update $i1 :set (= class $s2) :where (= $i3 $s4)] + table + (closql--abbrev-class class) + key id))) + +;;; Experimental + +(defun closql--iref (obj slot) + (pcase-let* + ((db (closql--oref obj 'closql-database)) + (`(,slot-table ,data-table) + (closql--slot-tables obj slot)) + (`(,where ,slot-join) (closql--table-columns db slot-table)) + (`(,_ ,data-join . ,select) (closql--table-columns db data-table)) + (object-id (closql--oref obj (oref-default obj closql-primary-key)))) + (emacsql db [:select $i1 :from $i2 :join $i3 + :on (= $i4 $i5) + :where (= $i6 $s7) :order-by [(asc $i8)]] + (vconcat select) data-table slot-table + (intern (format "%s:%s" slot-table slot-join)) + (intern (format "%s:%s" data-table data-join)) + where object-id (car select)))) + +(defun closql--slot-tables (obj slot) + (let ((tables (closql--slot-get obj slot :closql-table))) + (unless (listp tables) + (error "%s isn't an indirect slot" slot)) + (list (intern (string-replace "-" "_" (symbol-name (nth 0 tables)))) + (intern (string-replace "-" "_" (symbol-name (nth 1 tables))))))) + +;;; Utilities + +(defun closql-format (object string &rest slots) + "Format a string out of a format STRING and an OBJECT's SLOTS. + +STRING is a format-string like for `format'. OBJECT is an Eieio +object and SLOTS are slots of that object, their values are used +like `format' uses its OBJECTS arguments (which are unrelated to +this function's OBJECT argument, they just have similar names). + +While this function does not have much to do with the purpose of +`closql', it is being defined here anyway because Eieio does not +define a similar function under a more appropriate name such as +`eieio-format'." + (apply #'format string + (mapcar (lambda (slot) (eieio-oref object slot)) slots))) + +;;; _ +(provide 'closql) +;; Local Variables: +;; indent-tabs-mode: nil +;; End: +;;; closql.el ends here