feat(sqlite): add concrete data source

Adapt Emacs SQLite to the core ETAF Data Source contract with typed schema validation, safe queries, transactions, pagination, mutations, tests, and bilingual usage documentation.

.gitignore

@@ -0,0 +1,2 @@
+*.elc
+tests/*.elc

Makefile

@@ -0,0 +1,28 @@
+EMACS ?= emacs
+LOAD_PATH = -L . -L ../etaf -L ../emacs-box
+
+.PHONY: all compile test check checkdoc load clean
+
+all: check
+
+compile:
+	rm -f *.elc tests/*.elc
+	$(EMACS) -Q --batch $(LOAD_PATH) --eval '(setq load-prefer-newer t)' \
+		--eval '(load-file "etaf-sqlite.el")' \
+		--eval '(byte-compile-file "etaf-sqlite.el")'
+
+test: compile
+	$(EMACS) -Q --batch $(LOAD_PATH) --eval '(setq load-prefer-newer t)' \
+		-l tests/etaf-sqlite-tests.el -f ert-run-tests-batch-and-exit
+
+load: compile
+	$(EMACS) -Q --batch $(LOAD_PATH) --eval '(require (quote etaf-sqlite))' \
+		--eval '(princ "etaf-sqlite load OK\n")'
+
+checkdoc:
+	$(EMACS) -Q --batch --eval '(progn (require (quote checkdoc)) (dolist (file (directory-files "." t)) (when (string-suffix-p ".el" file) (checkdoc-file file))))'
+
+check: checkdoc compile test
+
+clean:
+	rm -f *.elc tests/*.elc

README.md

@@ -0,0 +1,21 @@
+# etaf-sqlite
+
+`etaf-sqlite` is the concrete SQLite storage package for ETAF. It adapts Emacs' built-in SQLite support to the core `etaf-data-source` capability contract. The Data Controller remains in `etaf`; this package owns only schema validation, short-lived connections, pagination queries, and synchronous mutations.
+
+```elisp
+(require 'etaf-sqlite)
+
+(let* ((table (etaf-sqlite-table
+               'items
+               (list (etaf-sqlite-column :id "id" :type 'integer :primary t)
+                     (etaf-sqlite-column :name "name" :type 'text))
+               :id))
+       (database (etaf-sqlite-database "~/items.sqlite" table))
+       (source (etaf-sqlite-source database)))
+  (etaf-sqlite-initialize database)
+  (etaf-data-controller source :auto-load t))
+```
+
+Other databases, REST services, files, and ORMs should implement the same source capability in their own packages; they do not belong in ETAF core or in a generic `etaf-adapters` layer.
+
+Run `make check EMACS=/Applications/Emacs.app/Contents/MacOS/Emacs` from this directory.

README.zh-CN.md

@@ -0,0 +1,21 @@
+# etaf-sqlite
+
+`etaf-sqlite` 是 ETAF 的具体 SQLite 存储包，把 Emacs 内置 SQLite 能力适配到核心 `etaf-data-source` 契约。Data Controller 仍属于 `etaf`；本包只负责 schema 校验、短连接、分页查询和同步 mutation。
+
+```elisp
+(require 'etaf-sqlite)
+
+(let* ((table (etaf-sqlite-table
+               'items
+               (list (etaf-sqlite-column :id "id" :type 'integer :primary t)
+                     (etaf-sqlite-column :name "name" :type 'text))
+               :id))
+       (database (etaf-sqlite-database "~/items.sqlite" table))
+       (source (etaf-sqlite-source database)))
+  (etaf-sqlite-initialize database)
+  (etaf-data-controller source :auto-load t))
+```
+
+其他数据库、REST、文件和 ORM 应在各自的具体数据源包中实现同一个 source capability；它们不进入 ETAF core，也不创建笼统的 `etaf-adapters` 层。
+
+在该目录运行 `make check EMACS=/Applications/Emacs.app/Contents/MacOS/Emacs`。

etaf-sqlite.el

@@ -0,0 +1,415 @@
+;;; etaf-sqlite.el --- SQLite Data source for ETAF -*- lexical-binding: t; -*-
+
+;; SPDX-License-Identifier: GPL-3.0-or-later
+;; Author: ETAF contributors
+;; Version: 0.1.0
+;; Package-Requires: ((emacs "29.1") (etaf "0.1.0"))
+;; URL: https://github.com/ginqi7/etaf-sqlite
+
+;;; Commentary:
+
+;; This package adapts Emacs' built-in SQLite API to the small capability
+;; contract owned by `etaf-data'.  It is intentionally a source adapter, not a
+;; second Data controller and not a general ORM.  Other storage systems can
+;; implement the same `etaf-data-source' callbacks without changing ETAF.
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'subr-x)
+(require 'sqlite)
+(require 'etaf-data)
+
+(define-error 'etaf-sqlite-error "Invalid ETAF SQLite operation")
+(define-error 'etaf-sqlite-schema-error "Invalid ETAF SQLite schema"
+  'etaf-sqlite-error)
+(define-error 'etaf-sqlite-unavailable "SQLite is unavailable"
+  'etaf-sqlite-error)
+
+(cl-defstruct (etaf-sqlite--column
+               (:constructor etaf-sqlite--column-create))
+  id sql-name type nullable primary)
+
+(cl-defstruct (etaf-sqlite--table
+               (:constructor etaf-sqlite--table-create))
+  id columns primary-key index)
+
+(cl-defstruct (etaf-sqlite--database
+               (:constructor etaf-sqlite--database-create))
+  file table)
+
+(defconst etaf-sqlite--types
+  '(integer real text blob any)
+  "Supported SQLite declaration types.")
+
+(defun etaf-sqlite--identifier-p (value)
+  "Return non-nil when VALUE is a safe unquoted SQL identifier."
+  (and (stringp value)
+       (string-match-p "\\`[A-Za-z_][A-Za-z0-9_]*\\'" value)))
+
+(defun etaf-sqlite--identifier (value kind)
+  "Return quoted SQL identifier VALUE for KIND or signal an error."
+  (unless (etaf-sqlite--identifier-p value)
+    (signal 'etaf-sqlite-schema-error
+            (list (format "Unsafe SQLite %s identifier: %S" kind value))))
+  (format "\"%s\"" value))
+
+(defun etaf-sqlite--physical-name (value kind)
+  "Return the SQL name for semantic VALUE of KIND."
+  (etaf-sqlite--identifier
+   (cond
+    ((stringp value) value)
+    ((symbolp value) (symbol-name value))
+    (t (signal 'etaf-sqlite-schema-error
+              (list (format "SQLite %s must be a symbol or string: %S"
+                            kind value)))))
+   kind))
+
+(defun etaf-sqlite--scalar-id-p (value)
+  "Return non-nil when VALUE can identify a schema field."
+  (and value (or (symbolp value) (stringp value) (integerp value))))
+
+;;;###autoload
+(cl-defun etaf-sqlite-column
+    (id sql-name &key (type 'any) nullable primary)
+  "Declare a SQLite column with semantic ID and physical SQL-NAME.
+
+TYPE is one of `integer', `real', `text', `blob', or `any'.  NULLABLE allows
+SQL NULL values.  PRIMARY marks the table identity column.  SQL-NAME is
+validated once and never comes from a runtime query."
+  (unless (etaf-sqlite--scalar-id-p id)
+    (signal 'etaf-sqlite-schema-error
+            (list (format "Column ID must be a stable scalar: %S" id))))
+  (unless (etaf-sqlite--identifier-p sql-name)
+    (signal 'etaf-sqlite-schema-error
+            (list (format "Invalid SQLite column name: %S" sql-name))))
+  (unless (memq type etaf-sqlite--types)
+    (signal 'etaf-sqlite-schema-error
+            (list (format "Unsupported SQLite column type: %S" type))))
+  (etaf-sqlite--column-create
+   :id id :sql-name sql-name :type type
+   :nullable (and nullable t) :primary (and primary t)))
+
+(defun etaf-sqlite--column-index (columns)
+  "Return an equal-tested index for COLUMNS."
+  (unless (and (proper-list-p columns) columns)
+    (signal 'etaf-sqlite-schema-error
+            (list "SQLite table requires at least one column")))
+  (let ((index (make-hash-table :test #'equal))
+        (names (make-hash-table :test #'equal)))
+    (dolist (column columns index)
+      (unless (etaf-sqlite--column-p column)
+        (signal 'etaf-sqlite-schema-error (list "Invalid SQLite column")))
+      (when (gethash (etaf-sqlite--column-id column) index)
+        (signal 'etaf-sqlite-schema-error
+                (list "Duplicate SQLite semantic column ID")))
+      (let ((name (downcase (etaf-sqlite--column-sql-name column))))
+        (when (gethash name names)
+          (signal 'etaf-sqlite-schema-error
+                  (list "Duplicate SQLite physical column name")))
+        (puthash name t names))
+      (puthash (etaf-sqlite--column-id column) column index))))
+
+;;;###autoload
+(defun etaf-sqlite-table (id columns &optional primary-key)
+  "Declare table ID from COLUMNS and optional PRIMARY-KEY semantic ID."
+  (unless (or (symbolp id) (stringp id))
+    (signal 'etaf-sqlite-schema-error
+            (list (format "Table ID must be a stable scalar: %S" id))))
+  (let* ((columns (copy-sequence columns))
+         (index (etaf-sqlite--column-index columns))
+         (primary (and primary-key (gethash primary-key index))))
+    (when (and primary-key (not primary))
+      (signal 'etaf-sqlite-schema-error
+              (list (format "Unknown primary column: %S" primary-key))))
+    (when primary
+      (setf (etaf-sqlite--column-primary primary) t
+            (etaf-sqlite--column-nullable primary) nil))
+    (etaf-sqlite--table-create :id id :columns columns
+                                :primary-key primary-key :index index)))
+
+;;;###autoload
+(defun etaf-sqlite-database (file table)
+  "Describe SQLite FILE using typed TABLE metadata."
+  (unless (and (stringp file) (not (string-empty-p file)))
+    (signal 'etaf-sqlite-schema-error (list "SQLite file must be nonempty")))
+  (unless (etaf-sqlite--table-p table)
+    (signal 'etaf-sqlite-schema-error (list "SQLite database needs a table")))
+  (etaf-sqlite--database-create :file (expand-file-name file) :table table))
+
+(defun etaf-sqlite--require-available ()
+  "Signal when the running Emacs has no SQLite support."
+  (unless (sqlite-available-p)
+    (signal 'etaf-sqlite-unavailable nil)))
+
+(defun etaf-sqlite--call (database function)
+  "Call FUNCTION with a short-lived connection for DATABASE."
+  (etaf-sqlite--require-available)
+  (let* ((file (etaf-sqlite--database-file database))
+         (directory (file-name-directory file))
+         connection)
+    (when directory
+      (make-directory directory t))
+    (setq connection (sqlite-open file))
+    (unwind-protect
+        (funcall function connection)
+      (when (sqlitep connection)
+        (sqlite-close connection)))))
+
+(defun etaf-sqlite--transaction (connection function)
+  "Run FUNCTION in a transaction on CONNECTION and return its value."
+  (sqlite-transaction connection)
+  (condition-case err
+      (prog1 (funcall function connection)
+        (sqlite-commit connection))
+    (error
+     (sqlite-rollback connection)
+     (signal (car err) (cdr err)))))
+
+(defun etaf-sqlite--sql-type (type)
+  "Return SQLite DDL type for TYPE."
+  (pcase type
+    ('integer "INTEGER")
+    ('real "REAL")
+    ('text "TEXT")
+    ('blob "BLOB")
+    (_ "BLOB")))
+
+(defun etaf-sqlite--column-ddl (column)
+  "Return DDL for COLUMN."
+  (concat (etaf-sqlite--identifier
+           (etaf-sqlite--column-sql-name column) "column")
+          " " (etaf-sqlite--sql-type
+                (etaf-sqlite--column-type column))
+          (when (etaf-sqlite--column-primary column) " PRIMARY KEY")
+          (unless (or (etaf-sqlite--column-nullable column)
+                      (etaf-sqlite--column-primary column))
+            " NOT NULL")))
+
+;;;###autoload
+(defun etaf-sqlite-initialize (database)
+  "Create DATABASE's table if it does not exist and return DATABASE."
+  (etaf-sqlite--call
+   database
+   (lambda (connection)
+     (sqlite-execute
+      connection
+              (format "CREATE TABLE IF NOT EXISTS %s (%s)"
+              (etaf-sqlite--physical-name
+               (etaf-sqlite--table-id (etaf-sqlite--database-table database))
+               "table")
+              (mapconcat #'etaf-sqlite--column-ddl
+                         (etaf-sqlite--table-columns
+                          (etaf-sqlite--database-table database)) ", ")))))
+  database)
+
+(defun etaf-sqlite--record-value (record key)
+  "Return KEY from plist, alist, or hash RECORD."
+  (cond
+   ((hash-table-p record) (gethash key record))
+   ((and (proper-list-p record) (keywordp (car record)))
+    (plist-get record key))
+   ((listp record) (alist-get key record))
+   (t nil)))
+
+(defun etaf-sqlite--query-pairs (table query)
+  "Return allowlisted (COLUMN . VALUE) pairs from QUERY using TABLE."
+  (cond
+   ((null query) nil)
+   ((and (proper-list-p query) (keywordp (car query)))
+    (cl-loop for (key value) on query by #'cddr
+             collect (cons (gethash key (etaf-sqlite--table-index table)) value)))
+   ((listp query)
+    (cl-loop for (key . value) in query
+             collect (cons (gethash key (etaf-sqlite--table-index table)) value)))
+   (t
+    (signal 'etaf-sqlite-error
+            (list "SQLite query must be a plist or alist")))))
+
+(defun etaf-sqlite--where (table query)
+  "Return (SQL . VALUES) for allowlisted equality QUERY using TABLE."
+  (let (parts values)
+    (dolist (pair (etaf-sqlite--query-pairs table query))
+      (unless (car pair)
+        (signal 'etaf-sqlite-error (list "Unknown SQLite query column")))
+      (push (format "%s = ?"
+                    (etaf-sqlite--identifier
+                     (etaf-sqlite--column-sql-name (car pair)) "column")
+                    ) parts)
+      (push (cdr pair) values))
+    (cons (if parts (concat " WHERE " (string-join (nreverse parts) " AND ")) "")
+          (nreverse values))))
+
+(defun etaf-sqlite--row-plist (table row)
+  "Convert positional SQLite ROW to a semantic plist using TABLE."
+  (let (result)
+    (cl-loop for column in (etaf-sqlite--table-columns table)
+             for value in row
+             do (setq result
+                      (append result
+                              (list (etaf-sqlite--column-id column) value))))
+    result))
+
+(defun etaf-sqlite--select-items (database query page page-size)
+  "Load PAGE of PAGE-SIZE items from DATABASE for QUERY."
+  (let* ((table (etaf-sqlite--database-table database))
+         (where (etaf-sqlite--where table query))
+         (values (cdr where))
+         (page (max 1 (or page 1)))
+         (page-size (max 1 (or page-size 20)))
+         (offset (* (1- page) page-size))
+         (names (mapcar (lambda (column)
+                          (etaf-sqlite--identifier
+                           (etaf-sqlite--column-sql-name column) "column"))
+                        (etaf-sqlite--table-columns table)))
+         (table-name (etaf-sqlite--physical-name
+                      (etaf-sqlite--table-id table) "table"))
+         (order (when-let ((primary (etaf-sqlite--table-primary-key table)))
+                  (format " ORDER BY %s"
+                          (etaf-sqlite--identifier
+                           (etaf-sqlite--column-sql-name
+                            (gethash primary (etaf-sqlite--table-index table)))
+                           "column")))))
+    (etaf-sqlite--call
+     database
+     (lambda (connection)
+       (let ((total (sqlite-select
+                     connection
+                     (format "SELECT COUNT(*) FROM %s%s" table-name
+                             (car where))
+                     values)))
+         (let ((rows (sqlite-select
+                      connection
+                      (format "SELECT %s FROM %s%s%s LIMIT ? OFFSET ?"
+                              (string-join names ", ") table-name (car where)
+                              (or order ""))
+                      (append values (list page-size offset)))))
+           (list :items (mapcar (lambda (row)
+                                  (etaf-sqlite--row-plist table row)) rows)
+                 :total (caar total)
+                 :page page :page-size page-size)))))))
+
+(defun etaf-sqlite--payload-columns (table payload)
+  "Return (COLUMN . VALUE) pairs from writable PAYLOAD fields using TABLE."
+  (let (result)
+    (dolist (column (etaf-sqlite--table-columns table) (nreverse result))
+      (let ((key (etaf-sqlite--column-id column)))
+        (when (and (not (etaf-sqlite--column-primary column))
+                   (or (plist-member payload key)
+                       (and (listp payload) (assoc key payload))))
+          (push (cons column (etaf-sqlite--record-value payload key)) result))))))
+
+(defun etaf-sqlite--mutate (database operation payload)
+  "Apply one Data mutation OPERATION with PAYLOAD to DATABASE."
+  (let* ((table (etaf-sqlite--database-table database))
+         (table-name (etaf-sqlite--physical-name
+                      (etaf-sqlite--table-id table) "table"))
+         (primary (etaf-sqlite--table-primary-key table)))
+    (unless primary
+      (signal 'etaf-sqlite-schema-error
+              (list "Mutations require a primary key")))
+    (etaf-sqlite--call
+     database
+     (lambda (connection)
+       (etaf-sqlite--transaction
+        connection
+        (lambda (transaction-connection)
+          (pcase operation
+            ('insert
+             (let* ((columns
+                     (cl-remove-if
+                      (lambda (column)
+                        (null
+                         (or (plist-member payload
+                                            (etaf-sqlite--column-id column))
+                             (and (listp payload)
+                                  (assoc (etaf-sqlite--column-id column)
+                                         payload)))))
+                      (etaf-sqlite--table-columns table)))
+                    (names
+                     (mapcar
+                      (lambda (column)
+                        (etaf-sqlite--identifier
+                         (etaf-sqlite--column-sql-name column) "column"))
+                      columns))
+                    (marks (make-list (length columns) "?")))
+               (unless columns
+                 (signal 'etaf-sqlite-error
+                         (list "Insert payload is empty")))
+               (sqlite-execute
+                transaction-connection
+                (format "INSERT INTO %s (%s) VALUES (%s)"
+                        table-name (string-join names ", ")
+                        (string-join marks ", "))
+                (mapcar
+                 (lambda (column)
+                   (etaf-sqlite--record-value
+                    payload (etaf-sqlite--column-id column)))
+                 columns))))
+            ((or 'replace 'update)
+             (let* ((id (etaf-sqlite--record-value payload primary))
+                    (columns (etaf-sqlite--payload-columns table payload)))
+               (unless id
+                 (signal 'etaf-sqlite-error
+                         (list "Update payload lacks primary key")))
+               (unless columns
+                 (signal 'etaf-sqlite-error
+                         (list "Update payload has no fields")))
+               (sqlite-execute
+                transaction-connection
+                (format "UPDATE %s SET %s WHERE %s = ?"
+                        table-name
+                        (mapconcat
+                         (lambda (pair)
+                           (format "%s = ?"
+                                   (etaf-sqlite--identifier
+                                    (etaf-sqlite--column-sql-name (car pair))
+                                    "column")))
+                         columns ", ")
+                        (etaf-sqlite--identifier
+                         (etaf-sqlite--column-sql-name
+                          (gethash primary (etaf-sqlite--table-index table)))
+                         "column"))
+                (append (mapcar #'cdr columns) (list id)))))
+            ('delete
+             (let ((id (if (and (listp payload)
+                                (or (plist-member payload primary)
+                                    (assoc primary payload)))
+                           (etaf-sqlite--record-value payload primary)
+                         payload)))
+               (unless id
+                 (signal 'etaf-sqlite-error
+                         (list "Delete payload lacks primary key")))
+               (sqlite-execute
+                transaction-connection
+                (format "DELETE FROM %s WHERE %s = ?" table-name
+                        (etaf-sqlite--identifier
+                         (etaf-sqlite--column-sql-name
+                          (gethash primary (etaf-sqlite--table-index table)))
+                         "column"))
+                (list id))))
+            (_
+             (signal 'etaf-sqlite-error
+                     (list (format "Unsupported SQLite mutation: %S"
+                                   operation)))))))))))
+
+;;;###autoload
+(defun etaf-sqlite-source (database)
+  "Return an `etaf-data-source' backed by DATABASE.
+
+The source accepts equality plist/alist queries and supports `insert',
+`replace', `update', and `delete' mutations.  Every operation uses a short
+connection; controllers remain the owner of reactive state and lifecycle."
+  (unless (etaf-sqlite--database-p database)
+    (signal 'wrong-type-argument
+            (list 'etaf-sqlite-database-p database)))
+  (etaf-data-source
+   :name 'etaf-sqlite
+   :load (lambda (query page page-size)
+           (etaf-sqlite--select-items database query page page-size))
+   :mutate (lambda (operation payload)
+             (etaf-sqlite--mutate database operation payload))))
+
+(provide 'etaf-sqlite)
+
+;;; etaf-sqlite.el ends here

tests/etaf-sqlite-tests.el

@@ -0,0 +1,82 @@
+;;; etaf-sqlite-tests.el --- ETAF SQLite source tests -*- lexical-binding: t; -*-
+
+(require 'ert)
+(require 'etaf-sqlite)
+
+(defun etaf-sqlite-test--database (file)
+  "Return a small typed test DATABASE at FILE."
+  (etaf-sqlite-database
+   file
+   (etaf-sqlite-table
+    'items
+    (list
+     (etaf-sqlite-column :id "id" :type 'integer :primary t)
+     (etaf-sqlite-column :name "name" :type 'text)
+     (etaf-sqlite-column :score "score" :type 'integer))
+    :id)))
+
+(cl-defmacro etaf-sqlite-test--with-database ((database) &rest body)
+  "Create a temporary DATABASE while evaluating BODY."
+  (declare (indent 1))
+  `(let* ((directory (make-temp-file "etaf-sqlite-" t))
+          (file (expand-file-name "data.sqlite" directory))
+          (,database (etaf-sqlite-test--database file)))
+     (unwind-protect
+         (progn
+           (etaf-sqlite-initialize ,database)
+           (let ((mutate (plist-get (etaf-sqlite-source ,database) :mutate)))
+             (funcall mutate 'insert '(:id 1 :name "Ada" :score 10))
+             (funcall mutate 'insert '(:id 2 :name "Grace" :score 20)))
+           ,@body)
+       (when (file-exists-p directory)
+         (delete-directory directory t)))))
+
+(ert-deftest etaf-sqlite-schema-rejects-unsafe-identifiers ()
+  "Identifiers are validated before they can reach SQL text."
+  (should-error (etaf-sqlite-column :id "id; DROP TABLE items")
+                :type 'etaf-sqlite-schema-error)
+  (should-error
+   (etaf-sqlite-table
+    'items (list (etaf-sqlite-column :id "id")) :missing)
+   :type 'etaf-sqlite-schema-error))
+
+(ert-deftest etaf-sqlite-source-loads-and-filters-pages ()
+  "The source should implement ETAF Data's load capability."
+  (etaf-sqlite-test--with-database (database)
+    (let* ((source (etaf-sqlite-source database))
+           (result (funcall (plist-get source :load) nil 1 1))
+           (filtered (funcall (plist-get source :load)
+                              '(:name "Grace") 1 10)))
+      (should (= (plist-get result :total) 2))
+      (should (= (length (plist-get result :items)) 1))
+      (should (equal (plist-get (car (plist-get result :items)) :name)
+                     "Ada"))
+      (should (= (plist-get filtered :total) 1)))))
+
+(ert-deftest etaf-sqlite-source-mutations-are-visible-to-data-controller ()
+  "Insert, update, and delete should share the Data source contract."
+  (etaf-sqlite-test--with-database (database)
+    (let ((controller (etaf-data-controller (etaf-sqlite-source database)
+                                            :page-size 20 :auto-load t)))
+      (unwind-protect
+          (progn
+            (etaf-data-mutate controller 'insert
+                               '(:id 3 :name "Alan" :score 30))
+            (should (= (etaf-value (etaf-data-total controller)) 3))
+            (etaf-data-mutate controller 'update
+                               '(:id 3 :name "Alan Turing" :score 31))
+            (should (string= (plist-get
+                              (car (cl-remove-if-not
+                                    (lambda (row)
+                                      (= (plist-get row :id) 3))
+                                    (etaf-value
+                                     (etaf-data-items controller))))
+                              :name)
+                             "Alan Turing"))
+            (etaf-data-mutate controller 'delete 3)
+            (should (= (etaf-value (etaf-data-total controller)) 2)))
+        (etaf-data-stop controller)))))
+
+(provide 'etaf-sqlite-tests)
+
+;;; etaf-sqlite-tests.el ends here