Repository: magit/emacsql
Branch: main
Commit: 2fe6d4562b32
Files: 23
Total size: 110.4 KB
Directory structure:
gitextract_pqc2acux/
├── .dir-locals.el
├── .elpaignore
├── .github/
│ └── workflows/
│ ├── compile.yml
│ ├── stats.yml
│ └── test.yml
├── .gitignore
├── Makefile
├── README.md
├── UNLICENSE
├── default.mk
├── docs/
│ └── Makefile
├── emacsql-compiler.el
├── emacsql-mysql.el
├── emacsql-pg.el
├── emacsql-psql.el
├── emacsql-sqlite-builtin.el
├── emacsql-sqlite-module.el
├── emacsql-sqlite.el
├── emacsql.el
└── test/
├── .nosearch
├── Makefile
├── emacsql-compiler-tests.el
└── emacsql-external-tests.el
================================================
FILE CONTENTS
================================================
================================================
FILE: .dir-locals.el
================================================
((nil
(indent-tabs-mode . nil))
(makefile-mode
(indent-tabs-mode . t))
(git-commit-mode
(git-commit-major-mode . git-commit-elisp-text-mode)))
================================================
FILE: .elpaignore
================================================
.dir-locals.el
.elpaignore
.github
.gitignore
Makefile
tests
UNLICENSE
================================================
FILE: .github/workflows/compile.yml
================================================
name: Compile
on: [push, pull_request]
jobs:
compile:
name: Compile
uses: | # zizmor: ignore[unpinned-uses] same maintainer as this repo
emacscollective/workflows/.github/workflows/compile.yml@main
================================================
FILE: .github/workflows/stats.yml
================================================
name: Statistics
on:
push:
branches: main
schedule:
- cron: '3 13 * * 1'
jobs:
stats:
name: Statistics
uses: | # zizmor: ignore[unpinned-uses] same maintainer as this repo
emacscollective/workflows/.github/workflows/stats.yml@main
secrets:
rclone_config: ${{ secrets.RCLONE_CONFIG }}
================================================
FILE: .github/workflows/test.yml
================================================
name: Test
permissions: read-all
on: [ push, pull_request ]
env:
pwd: ${{ github.event.repository.name }}
jobs:
matrix:
name: 'Get matrix'
runs-on: ubuntu-24.04
outputs:
matrix: ${{ steps.matrix.outputs.matrix }}
steps:
- name: 'Install Emacs'
uses: purcell/setup-emacs@bdc64dc730ae1fcba200bfd52cb1b4cf6159cbe5 # v8
with:
version: 30.1
- name: 'Install scripts'
uses: actions/checkout@de0fac2e4500dabe0009e67214ff5f5447ce83dd # v6.0.2
with:
repository: emacscollective/workflows
ref: ${{ inputs.workflow_ref }}
path: _scripts
persist-credentials: false
- name: 'Checkout ${{ github.repository }}'
uses: actions/checkout@de0fac2e4500dabe0009e67214ff5f5447ce83dd # v6.0.2
with:
path: ${{ env.pwd }}
persist-credentials: false
- name: 'Get matrix'
id: matrix
working-directory: ${{ env.pwd }}
env:
WORKFLOW_REF: ${{ inputs.workflow_ref }}
run: |
../_scripts/bin/get-matrix >> $GITHUB_OUTPUT
echo "• get-matrix: emacscollective/workflows@${WORKFLOW_REF}"
main:
name: 'Test using Emacs ${{ matrix.emacs }}'
runs-on: ubuntu-24.04
needs: matrix
strategy:
fail-fast: false
matrix:
emacs: ${{ fromJson(needs.matrix.outputs.matrix) }}
services:
postgres:
image: postgres:14
env:
POSTGRES_PASSWORD: postgres
POSTGRES_HOST_AUTH_METHOD: trust
options: >-
--health-cmd pg_isready
--health-interval 10s
--health-timeout 5s
--health-retries 5
ports:
- 5432:5432
mysql:
image: mysql:8.0
env:
MYSQL_ROOT_PASSWORD: emacsql
MYSQL_DATABASE: emacsql
MYSQL_USER: emacsql
MYSQL_PASSWORD: emacsql
ports:
- 3306:3306
options: >-
--health-cmd="mysqladmin ping"
--health-interval=10s
--health-timeout=5s
--health-retries=3
steps:
- name: 'Install Emacs'
uses: purcell/setup-emacs@bdc64dc730ae1fcba200bfd52cb1b4cf6159cbe5 # v8
with:
version: ${{ matrix.emacs }}
- name: 'Checkout scripts'
uses: actions/checkout@de0fac2e4500dabe0009e67214ff5f5447ce83dd # v6.0.2
with:
repository: emacscollective/workflows
ref: ${{ inputs.workflow_ref }}
path: _scripts
persist-credentials: false
- name: 'Checkout ${{ github.repository }}'
uses: actions/checkout@de0fac2e4500dabe0009e67214ff5f5447ce83dd # v6.0.2
with:
path: ${{ env.pwd }}
persist-credentials: false
- name: 'Install dependencies'
working-directory: ${{ env.pwd }}
run: ../_scripts/bin/install-deps
- name: 'Build Sqlite3'
working-directory: sqlite3
run: nix-shell -p sqlite.dev --run "make all"
- name: 'Build Emacsql'
run: nix-shell -p sqlite.dev --run "make all"
working-directory: ${{ env.pwd }}
- name: 'Test Emacsql'
run: make test
working-directory: ${{ env.pwd }}
env:
MYSQL_DATABASE: emacsql
MYSQL_USER: emacsql
MYSQL_PASSWORD: emacsql
MYSQL_HOST: 127.0.0.1
MYSQL_PORT: 3306
PSQL_DATABASE: postgres
PSQL_USER: postgres
PSQL_HOST: 127.0.0.1
PSQL_PORT: 5432
PG_DATABASE: postgres
PG_USER: postgres
PG_PASSWORD: postgres
PG_HOST: 127.0.0.1
PG_PORT: 5432
================================================
FILE: .gitignore
================================================
/*.elc
/*-autoloads.el
/config.mk
/docs/stats/
================================================
FILE: Makefile
================================================
-include config.mk
include default.mk
.PHONY: test
all: lisp
help:
$(info make all -- Generate lisp and manual)
$(info make lisp -- Generate byte-code and autoloads)
$(info make redo -- Re-generate byte-code and autoloads)
$(info make stats -- Generate statistics)
$(info make stats-upload -- Publish statistics)
$(info make test -- Run tests)
$(info make test-interactive -- Run tests interactively)
$(info make clean -- Remove most generated files)
@printf "\n"
lisp: $(ELCS) autoloads check-declare
redo: clean lisp
stats:
@$(MAKE) -C docs stats
stats-upload:
@$(MAKE) -C docs stats-upload
test: lisp
@$(MAKE) -C test test
test-interactive:
@$(MAKE) -C test test-interactive
clean: clean-lisp clean-docs clean-test
clean-lisp:
@printf " Cleaning *...\n"
@rm -rf $(ELCS) $(PKG)-autoloads.el
clean-docs:
@$(MAKE) -C docs clean
clean-test:
@$(MAKE) -C test clean
autoloads: $(PKG)-autoloads.el
%.elc: %.el
@printf "Compiling $<\n"
@$(EMACS_BATCH) --funcall batch-byte-compile $<
check-declare:
@printf " Checking function declarations\n"
@$(EMACS_BATCH) --eval "(check-declare-directory default-directory)"
$(PKG)-autoloads.el: $(ELS)
@printf " Creating $@\n"
@$(EMACS_BATCH) --load autoload --eval "\
(let* ((file (expand-file-name \"$@\"))\
(generated-autoload-file file)\
(coding-system-for-write 'utf-8-emacs-unix)\
(backup-inhibited t)\
(version-control 'never)\
(inhibit-message t))\
(write-region (autoload-rubric file \"package\" t) nil file)\
(update-directory-autoloads default-directory))" \
2>&1 | sed "/^Package autoload is deprecated$$/d"
================================================
FILE: README.md
================================================
# EmacSQL
EmacSQL is a high-level Emacs Lisp front-end for SQLite.
PostgreSQL and MySQL are also supported, but use of these connectors
is not recommended.
Any [readable lisp value][readable] can be stored as a value in
EmacSQL, including numbers, strings, symbols, lists, vectors, and
closures. EmacSQL has no concept of "TEXT" values; it's all just lisp
objects. The lisp object `nil` corresponds 1:1 with `NULL` in the
database.
Requires Emacs 26 or later.
[](https://github.com/magit/emacsql/actions/workflows/compile.yml)
[](https://github.com/magit/emacsql/actions/workflows/test.yml)
[](https://elpa.nongnu.org/nongnu-devel/emacsql.html)
[](https://stable.melpa.org/#/emacsql)
[](https://melpa.org/#/emacsql)
### FAQ
#### Why are all values stored as strings?
EmacSQL is not intended to interact with arbitrary databases, but to
be an ACID-compliant database for Emacs extensions. This means that
EmacSQL cannot be used with a regular SQL database used by other
non-Emacs clients.
All database values must be s-expressions. When EmacSQL stores a
value — string, symbol, cons, etc. — it is printed and written to
the database in its printed form. Strings are wrapped in quotes
and escaped as necessary. That means "bare" symbols in the database
generally look like strings. The only exception is `nil`, which is
stored as `NULL`.
#### Will EmacSQL ever support arbitrary databases?
The author of EmacSQL [thinks][mistake] that it was probably a
design mistake to restrict it to Emacs by storing only printed values,
and that it would be a lot more useful if it just handled primitive
database types.
However, EmacSQL is in maintenance mode and there are no plans to
make any fundamental changes, not least because they would break all
existing packages and databases that rely on the current EmacSQL
behavior.
### Windows Issues
Emacs `start-process-shell-command` function is not supported on
Windows. Since both `emacsql-mysql` and `emacsql-psql` rely on this
function, neither of these connection types are supported on Windows.
## Example Usage
```el
(defvar db (emacsql-sqlite-open "~/company.db"))
;; Create a table. Table and column identifiers are symbols.
(emacsql db [:create-table people ([name id salary])])
;; Or optionally provide column constraints.
(emacsql db [:create-table people
([name (id integer :primary-key) (salary float)])])
;; Insert some data:
(emacsql db [:insert :into people
:values (["Jeff" 1000 60000.0] ["Susan" 1001 64000.0])])
;; Query the database for results:
(emacsql db [:select [name id]
:from people
:where (> salary 62000)])
;; => (("Susan" 1001))
;; Queries can be templates, using $1, $2, etc.:
(emacsql db [:select [name id]
:from people
:where (> salary $s1)]
50000)
;; => (("Jeff" 1000) ("Susan" 1001))
```
When editing these prepared SQL s-expression statements, the `M-x
emacsql-show-last-sql` command (think `eval-last-sexp`) is useful for
seeing what the actual SQL expression will become when compiled.
## Schema
A table schema is a list whose first element is a vector of column
specifications. The rest of the list specifies table constraints. A
column identifier is a symbol and a column's specification can either
be just this symbol or it can include constraints as a list. Because
EmacSQL stores entire lisp objects as values, the only relevant (and
allowed) types are `integer`, `float`, and `object` (default).
([(<column>) ...] (<table-constraint> ...) ...])
Dashes in identifiers are converted into underscores when compiled
into SQL. This allows for lisp-style identifiers to be used in SQL.
Constraints follow the compilation rules below.
```el
;; No constraints schema with four columns:
([name id building room])
;; Add some column constraints:
([(name :unique) (id integer :primary-key) building room])
;; Add some table constraints:
([(name :unique) (id integer :primary-key) building room]
(:unique [building room])
(:check (> id 0)))
```
Here's an example using foreign keys.
```el
;; "subjects" table schema
([(id integer :primary-key) subject])
;; "tag" table references subjects
([(subject-id integer) tag]
(:foreign-key [subject-id] :references subjects [id]
:on-delete :cascade))
```
Foreign key constraints are enabled by default in EmacSQL.
## Operators
Expressions are written lisp-style, with the operator first. If it
looks like an operator EmacSQL treats it like an operator. However,
several operators are special.
<= >= funcall quote
The `<=` and `>=` operators accept 2 or 3 operands, transforming into
a SQL `_ BETWEEN _ AND _` operator as appropriate.
For function-like "operators" like `count` and `max` use the `funcall`
"operator."
```el
[:select (funcall max age) :from people]
```
With `glob` and `like` SQL operators keep in mind that they're
matching the *printed* representations of these values, even if the
value is a string.
The `||` concatenation operator is unsupported because concatenating
printed representations breaks an important constraint: all values must
remain readable within SQLite.
## Quoting
Inside expressions, EmacSQL cannot tell the difference between symbol
literals and column references. If you're talking about the symbol
itself, just quote it as you would in normal Elisp. Note that this
does not "escape" `$tn` parameter symbols.
```el
(emacsql db [... :where (= category 'hiking)])
```
Quoting a string makes EmacSQL handle it as a "raw string." These raw
strings are not printed when being assembled into a query. These are
intended for use in special circumstances like filenames (`ATTACH`) or
pattern matching (`LIKE`). It is vital that raw strings are not
returned as results.
```el
(emacsql db [... :where (like name '"%foo%")])
(emacsql db [:attach '"/path/to/foo.db" :as foo])
```
Since template parameters include their type they never need to be
quoted.
## Prepared Statements
The database is interacted with via prepared SQL s-expression
statements. You shouldn't normally be concatenating strings on your
own. (And it leaves out any possibility of a SQL injection!) See the
"Usage" section above for examples. A statement is a vector of
keywords and other lisp object.
Prepared EmacSQL s-expression statements are compiled into SQL
statements. The statement compiler is memorized so that using the same
statement multiple times is fast. To assist in this, the statement can
act as a template -- using `$i1`, `$s2`, etc. -- working like the
Elisp `format` function.
### Compilation Rules
Rather than the typical uppercase SQL keywords, keywords in a prepared
EmacSQL statement are literally just that: lisp keywords. EmacSQL only
understands a very small amount of SQL's syntax. The compiler follows
some simple rules to convert an s-expression into SQL.
#### All prepared statements are vectors.
A prepared s-expression statement is a vector beginning with a keyword
followed by a series of keywords and special values. This includes
most kinds of sub-queries.
```el
[:select ... :from ...]
[:select tag :from tags
:where (in tag [:select ...])]
```
#### Keywords are split and capitalized.
Dashes are converted into spaces and the keyword gets capitalized. For
example, `:if-not-exists` becomes `IF NOT EXISTS`. How you choose to
combine keywords is up to your personal taste (e.g., `:drop :table` vs.
`:drop-table`).
#### Standalone symbols are identifiers.
EmacSQL doesn't know what symbols refer to identifiers and what
symbols should be treated as values. Use quotes to mark a symbol as a
value. For example, `people` here will be treated as an identifier.
```el
[:insert-into people :values ...]
```
#### Row-oriented information is always represented as vectors.
This includes rows being inserted, and sets of columns in a query. If
you're talking about a row-like thing then put it in a vector.
```el
[:select [id name] :from people]
```
Note that `*` is actually a SQL keyword, so don't put it in a vector.
```el
[:select * :from ...]
```
#### Lists are treated as expressions.
This is true even within row-oriented vectors.
```el
[... :where (= name "Bob")]
[:select [(/ seconds 60) count] :from ...]
```
Some things that are traditionally keywords -- particularly those that
are mixed in with expressions -- have been converted into operators
(`AS`, `ASC`, `DESC`).
```el
[... :order-by [(asc b), (desc a)]] ; "ORDER BY b ASC, a DESC"
[:select p:name :from (as people p)] ; "SELECT p.name FROM people AS p"
```
#### The `:values` keyword is special.
What follows `:values` is always treated like a vector or list of
vectors. Normally this sort of thing would appear to be a column
reference.
```el
[... :values [1 2 3]]
[... :values ([1 2 3] [4 5 6])] ; insert multiple rows
```
#### A list whose first element is a vector is a table schema.
This is to distinguish schemata from everything else. With the
exception of what follows `:values`, nothing else is shaped like this.
```el
[:create-table people ([(id :primary-key) name])]
```
### Templates
To make statement compilation faster, and to avoid making you build up
statements dynamically, you can insert `$tn` parameters in place of
identifiers and values. These refer to the argument's type and its
argument position after the statement in the `emacsql` function,
one-indexed.
```el
(emacsql db [:select * :from $i1 :where (> salary $s2)] 'employees 50000)
(emacsql db [:select * :from employees :where (like name $r1)] "%Smith%")
```
The letter before the number is the type.
* `i` : identifier
* `s` : scalar
* `v` : vector (or multiple vectors)
* `r` : raw, unprinted strings
* `S` : schema
When combined with `:values`, the vector type can refer to lists of
rows.
```el
(emacsql db [:insert-into favorite-characters :values $v1]
'([0 "Calvin"] [1 "Hobbes"] [3 "Susie"]))
```
This is why rows must be vectors and not lists.
### Ignored Features
EmacSQL doesn't cover all of SQLite's features. Here are a list of
things that aren't supported, and probably will never be.
* Collating. SQLite has three built-in collation functions: BINARY
(default), NOCASE, and RTRIM. EmacSQL values never have right-hand
whitespace, so RTRIM won't be of any use. NOCASE is broken
(ASCII-only) and there's little reason to use it.
* Text manipulation functions. Like collating this is incompatible
with EmacSQL s-expression storage.
* Date and time. These are incompatible with the printed values
stored by EmacSQL and therefore have little use.
## Limitations
EmacSQL is *not* intended to play well with other programs accessing
the SQLite database. Non-numeric values are stored encoded as
s-expressions TEXT values. This avoids ambiguities in parsing output
from the command line and allows for storage of Emacs richer data
types. This is an efficient, ACID-compliant database specifically for
Emacs.
## Emacs Lisp Indentation Annoyance
By default, `emacs-lisp-mode` indents vectors as if they were regular
function calls.
```el
;; Ugly indentation!
(emacsql db [:select *
:from people
:where (> age 60)])
```
Calling the function `emacsql-fix-vector-indentation` (interactive)
advises the major mode to fix this annoyance.
```el
;; Such indent!
(emacsql db [:select *
:from people
:where (> age 60)])
```
## Contributing and Extending
To run the test suite, clone the `pg` and `sqlite3` packages into
sibling directories. The Makefile will automatically put these paths on
the Emacs load path (override `LDFLAGS` if your situation is different).
```shell
git clone https://github.com/emarsden/pg-el ../pg
git clone https://github.com/pekingduck/emacs-sqlite3-api ../sqlite3
```
Or set `LOAD_PATH` to point at these packages elsewhere:
```shell
make LOAD_PATH='-L path/to/pg -L path/to/sqlite3'
```
Then invoke make:
```shell
make test
```
If the environment variable `PGDATABASE` is present then the unit
tests will also be run with PostgreSQL (emacsql-psql). Provide
`PGHOST`, `PGPORT`, and `PGUSER` if needed. If `PGUSER` is provided,
the pg.el back-end (emacsql-pg) will also be tested.
If the environment variable `MYSQL_DBNAME` is present then the unit
tests will also be run with MySQL in the named database. Note that
this is not an official MySQL variable, just something made up for
EmacSQL.
### Creating a New Front-end
EmacSQL uses EIEIO so that interactions with a connection occur
through generic functions. You need to define a new class that
inherits from `emacsql-connection`.
* Implement `emacsql-send-message`, `emacsql-waiting-p`,
`emacsql-parse`, and `emacsql-close`.
* Provide a constructor that initializes the connection and calls
`emacsql-register` (for automatic connection cleanup).
* Provide `emacsql-types` if needed (hint: use a class-allocated slot).
* Ensure that you properly read NULL as nil (hint: ask your back-end
to print it that way).
* Register all reserved words with `emacsql-register-reserved`.
* Preferably provide `emacsql-reconnect` if possible.
* Set the default isolation level to *serializable*.
* Enable autocommit mode by default.
* Prefer ANSI syntax (value escapes, identifier escapes, etc.).
* Enable foreign key constraints by default.
The goal of the autocommit, isolation, parsing, and foreign key
configuration settings is to normalize the interface as much as
possible. The connection's user should have the option to be agnostic
about which back-end is actually in use.
The provided implementations should serve as useful examples. If your
back-end outputs data in a clean, standard way you may be able to use
the emacsql-protocol-mixin class to do most of the work.
## See Also
* [SQLite Documentation](https://www.sqlite.org/docs.html)
[readable]: http://nullprogram.com/blog/2013/12/30/#almost_everything_prints_readably
[mistake]: https://github.com/magit/emacsql/issues/35#issuecomment-346352439
<!-- LocalWords: EIEIO Elisp EmacSQL MELPA Makefile NOCASE RTRIM -->
<!-- LocalWords: SQL's autocommit el emacsql unprinted whitespace -->
================================================
FILE: UNLICENSE
================================================
This is free and unencumbered software released into the public domain.
Anyone is free to copy, modify, publish, use, compile, sell, or
distribute this software, either in source code form or as a compiled
binary, for any purpose, commercial or non-commercial, and by any
means.
In jurisdictions that recognize copyright laws, the author or authors
of this software dedicate any and all copyright interest in the
software to the public domain. We make this dedication for the benefit
of the public at large and to the detriment of our heirs and
successors. We intend this dedication to be an overt act of
relinquishment in perpetuity of all present and future rights to this
software under copyright law.
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR
OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,
ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
OTHER DEALINGS IN THE SOFTWARE.
For more information, please refer to <http://unlicense.org/>
================================================
FILE: default.mk
================================================
TOP := $(dir $(lastword $(MAKEFILE_LIST)))
DOMAIN ?= magit.vc
PKG = emacsql
ELS = $(PKG)-compiler.el
ELS += $(PKG).el
ELS += $(PKG)-sqlite.el
ELS += $(PKG)-sqlite-builtin.el
ELS += $(PKG)-sqlite-module.el
ELS += $(PKG)-mysql.el
ELS += $(PKG)-psql.el
ELS += $(PKG)-pg.el
ELCS = $(ELS:.el=.elc)
DEPS = pg
DEPS += peg
DEPS += sqlite3
LOAD_PATH ?= $(addprefix -L ../,$(DEPS))
LOAD_PATH += -L .
LOAD_PATH += -L ./test
ifeq ($(CI), true)
# Workaround for bug#58252 on Emacs 28.x.
override EMACS_ARGS += --eval "(setq byte-compile-docstring-max-column 120)"
else
EMACS_ARGS ?=
endif
EMACS ?= emacs
EMACS_Q_ARG ?= -Q
EMACS_BATCH ?= $(EMACS) $(EMACS_Q_ARG) --batch $(EMACS_ARGS) $(LOAD_PATH)
EMACS_INTR ?= $(EMACS) $(EMACS_Q_ARG) $(EMACS_ARGS) $(LOAD_PATH)
GITSTATS ?= gitstats
GITSTATS_DIR ?= stats
GITSTATS_ARGS ?= -c style=https://magit.vc/assets/stats.css -c max_authors=999
RCLONE ?= rclone
RCLONE_ARGS ?= -v
ifdef NIX_PATH
export SQLITE3_API_BUILD_COMMAND = nix-shell -p sqlite.dev --run "make all"
endif
================================================
FILE: docs/Makefile
================================================
-include ../config.mk
include ../default.mk
.PHONY: stats
STAT_DOMAIN = stats.$(DOMAIN)
STAT_TARGET = $(subst .,_,$(STAT_DOMAIN)):$(PKG)/
stats:
@printf "Generating statistics...\n"
@$(GITSTATS) $(GITSTATS_ARGS) $(TOP) $(GITSTATS_DIR)
stats-upload:
@printf "Uploading statistics...\n"
@$(RCLONE) sync $(RCLONE_ARGS) stats $(STAT_TARGET)
CLEAN = $(GITSTATS_DIR)
clean:
@printf " Cleaning docs/*...\n"
@rm -rf $(CLEAN)
================================================
FILE: emacsql-compiler.el
================================================
;;; emacsql-compiler.el --- S-expression SQL compiler -*- lexical-binding:t -*-
;; This is free and unencumbered software released into the public domain.
;; Author: Christopher Wellons <wellons@nullprogram.com>
;; Maintainer: Jonas Bernoulli <emacs.emacsql@jonas.bernoulli.dev>
;; SPDX-License-Identifier: Unlicense
;;; Commentary:
;; This library provides support for compiling S-expressions to SQL.
;;; Code:
(require 'cl-lib)
(eval-when-compile (require 'subr-x))
;;; Error symbols
(defmacro emacsql-deferror (symbol parents message)
"Defines a new error symbol for EmacSQL."
(declare (indent 2))
(let ((conditions (cl-remove-duplicates
(append parents (list symbol 'emacsql-error 'error)))))
`(prog1 ',symbol
(put ',symbol 'error-conditions ',conditions)
(put ',symbol 'error-message ,message))))
(emacsql-deferror emacsql-error () ;; parent condition for all others
"EmacSQL had an unhandled condition")
(emacsql-deferror emacsql-syntax () "Invalid SQL statement")
(emacsql-deferror emacsql-internal () "Internal error")
(emacsql-deferror emacsql-locked () "Database locked")
(emacsql-deferror emacsql-fatal () "Fatal error")
(emacsql-deferror emacsql-memory () "Out of memory")
(emacsql-deferror emacsql-corruption () "Database corrupted")
(emacsql-deferror emacsql-access () "Database access error")
(emacsql-deferror emacsql-timeout () "Query timeout error")
(emacsql-deferror emacsql-warning () "Warning message")
(defun emacsql-error (format &rest args)
"Like `error', but signal an emacsql-syntax condition."
(signal 'emacsql-syntax (list (apply #'format format args))))
;;; Escaping functions
(defvar emacsql-reserved (make-hash-table :test 'equal)
"Collection of all known reserved words, used for escaping.")
(defun emacsql-register-reserved (seq)
"Register sequence of keywords as reserved words, returning SEQ."
(cl-loop for word being the elements of seq
do (setf (gethash (upcase (format "%s" word)) emacsql-reserved) t)
finally (cl-return seq)))
(defun emacsql-reserved-p (name)
"Returns non-nil if string NAME is a SQL keyword."
(gethash (upcase name) emacsql-reserved))
(defun emacsql-quote-scalar (string)
"Single-quote (scalar) STRING for use in a SQL expression."
(with-temp-buffer
(insert string)
(goto-char (point-min))
(while (re-search-forward "'" nil t)
(replace-match "''"))
(goto-char (point-min))
(insert "'")
(goto-char (point-max))
(insert "'")
(buffer-string)))
(defun emacsql-quote-character (c)
"Single-quote character C for use in a SQL expression."
(if (char-equal c ?')
"''''"
(format "'%c'" c)))
(defun emacsql-quote-identifier (string)
"Double-quote (identifier) STRING for use in a SQL expression."
(format "\"%s\"" (replace-regexp-in-string "\"" "\"\"" string)))
(defun emacsql-escape-identifier (identifier)
"Escape an identifier, if needed, for SQL."
(when (or (null identifier)
(keywordp identifier)
(not (or (symbolp identifier)
(vectorp identifier))))
(emacsql-error "Invalid identifier: %S" identifier))
(cond
((vectorp identifier)
(mapconcat #'emacsql-escape-identifier identifier ", "))
((eq identifier '*) "*")
(t
(let ((name (symbol-name identifier)))
(if (string-match-p ":" name)
(mapconcat #'emacsql-escape-identifier
(mapcar #'intern (split-string name ":")) ".")
(let ((print (replace-regexp-in-string "-" "_" (format "%S" identifier)))
(special "[]-\000-\040!\"#%&'()*+,./:;<=>?@[\\^`{|}~\177]"))
(if (or (string-match-p special print)
(string-match-p "^[0-9$]" print)
(emacsql-reserved-p print))
(emacsql-quote-identifier print)
print)))))))
(defvar print-escape-control-characters)
(defun emacsql-escape-scalar (value)
"Escape VALUE for sending to SQLite."
(let ((print-escape-newlines t)
(print-escape-control-characters t))
(cond ((null value) "NULL")
((numberp value) (prin1-to-string value))
((emacsql-quote-scalar (prin1-to-string value))))))
(defun emacsql-escape-raw (value)
"Escape VALUE for sending to SQLite."
(cond ((null value) "NULL")
((stringp value) (emacsql-quote-scalar value))
((error "Expected string or nil"))))
(defun emacsql-escape-vector (vector)
"Encode VECTOR into a SQL vector scalar."
(cl-typecase vector
(null (emacsql-error "Empty SQL vector expression"))
(list (mapconcat #'emacsql-escape-vector vector ", "))
(vector (concat "(" (mapconcat #'emacsql-escape-scalar vector ", ") ")"))
(otherwise (emacsql-error "Invalid vector %S" vector))))
(defun emacsql-escape-format (thing)
"Escape THING for use as a `format' spec."
(replace-regexp-in-string "%" "%%" thing))
;;; Schema compiler
(defvar emacsql-type-map
'((integer "&INTEGER")
(float "&REAL")
(object "&TEXT")
(nil "&NONE"))
"An alist mapping EmacSQL types to SQL types.")
(defun emacsql--from-keyword (keyword)
"Convert KEYWORD into SQL."
(let ((name (substring (symbol-name keyword) 1)))
(upcase (replace-regexp-in-string "-" " " name))))
(defun emacsql--prepare-constraints (constraints)
"Compile CONSTRAINTS into a partial SQL expression."
(mapconcat
#'identity
(cl-loop for constraint in constraints collect
(cl-typecase constraint
(null "NULL")
(keyword (emacsql--from-keyword constraint))
(symbol (emacsql-escape-identifier constraint))
(vector (format "(%s)"
(mapconcat
#'emacsql-escape-identifier
constraint
", ")))
(list (format "(%s)"
(car (emacsql--*expr constraint))))
(otherwise
(emacsql-escape-scalar constraint))))
" "))
(defun emacsql--prepare-column (column)
"Convert COLUMN into a partial SQL string."
(mapconcat
#'identity
(cl-etypecase column
(symbol (list (emacsql-escape-identifier column)
(cadr (assoc nil emacsql-type-map))))
(list (cl-destructuring-bind (name . constraints) column
(cl-delete-if
(lambda (s) (zerop (length s)))
(list (emacsql-escape-identifier name)
(if (member (car constraints) '(integer float object))
(cadr (assoc (pop constraints) emacsql-type-map))
(cadr (assoc nil emacsql-type-map)))
(emacsql--prepare-constraints constraints))))))
" "))
(defun emacsql-prepare-schema (schema)
"Compile SCHEMA into a SQL string."
(if (vectorp schema)
(emacsql-prepare-schema (list schema))
(cl-destructuring-bind (columns . constraints) schema
(mapconcat
#'identity
(nconc
(mapcar #'emacsql--prepare-column columns)
(mapcar #'emacsql--prepare-constraints constraints))
", "))))
;;; Statement compilation
(defvar emacsql-prepare-cache (make-hash-table :test 'equal :weakness 'key)
"Cache used to memoize `emacsql-prepare'.")
(defvar emacsql--vars ()
"Used within `emacsql-with-params' to collect parameters.")
(defun emacsql-sql-p (thing)
"Return non-nil if THING looks like a prepared statement."
(and (vectorp thing) (> (length thing) 0) (keywordp (aref thing 0))))
(defun emacsql-param (thing)
"Return the index and type of THING, or nil if THING is not a parameter.
A parameter is a symbol that looks like $i1, $s2, $v3, etc. The
letter refers to the type: identifier (i), scalar (s),
vector (v), raw string (r), schema (S)."
(and (symbolp thing)
(let ((name (symbol-name thing)))
(and (string-match-p "^\\$[isvrS][0-9]+$" name)
(cons (1- (read (substring name 2)))
(cl-ecase (aref name 1)
(?i :identifier)
(?s :scalar)
(?v :vector)
(?r :raw)
(?S :schema)))))))
(defmacro emacsql-with-params (prefix &rest body)
"Evaluate BODY, collecting parameters.
Provided local functions: `param', `identifier', `scalar', `raw',
`svector', `expr', `subsql', and `combine'. BODY should return a
string, which will be combined with variable definitions."
(declare (indent 1))
`(let ((emacsql--vars ()))
(cl-flet* ((combine (prepared) (emacsql--*combine prepared))
(param (thing) (emacsql--!param thing))
(identifier (thing) (emacsql--!param thing :identifier))
(scalar (thing) (emacsql--!param thing :scalar))
(raw (thing) (emacsql--!param thing :raw))
(svector (thing) (combine (emacsql--*vector thing)))
(expr (thing) (combine (emacsql--*expr thing)))
(subsql (thing)
(format "(%s)" (combine (emacsql-prepare thing)))))
(cons (concat ,prefix (progn ,@body)) emacsql--vars))))
(defun emacsql--!param (thing &optional kind)
"Parse, escape, and store THING.
If optional KIND is not specified, then try to guess it.
Only use within `emacsql-with-params'!"
(cl-flet ((check (param)
(when (and kind (not (eq kind (cdr param))))
(emacsql-error
"Invalid parameter type %s, expecting %s" thing kind))))
(let ((param (emacsql-param thing)))
(if (null param)
(emacsql-escape-format
(if kind
(cl-case kind
(:identifier (emacsql-escape-identifier thing))
(:scalar (emacsql-escape-scalar thing))
(:vector (emacsql-escape-vector thing))
(:raw (emacsql-escape-raw thing))
(:schema (emacsql-prepare-schema thing)))
(if (and (not (null thing))
(not (keywordp thing))
(symbolp thing))
(emacsql-escape-identifier thing)
(emacsql-escape-scalar thing))))
(prog1 (if (eq (cdr param) :schema) "(%s)" "%s")
(check param)
(setq emacsql--vars (nconc emacsql--vars (list param))))))))
(defun emacsql--*vector (vector)
"Prepare VECTOR."
(emacsql-with-params ""
(cl-typecase vector
(symbol (emacsql--!param vector :vector))
(list (mapconcat #'svector vector ", "))
(vector (format "(%s)" (mapconcat #'scalar vector ", ")))
(otherwise (emacsql-error "Invalid vector: %S" vector)))))
(defmacro emacsql--generate-op-lookup-defun (name operator-precedence-groups)
"Generate function to look up predefined SQL operator metadata.
The generated function is bound to NAME and accepts two
arguments, OPERATOR-NAME and OPERATOR-ARGUMENT-COUNT.
OPERATOR-PRECEDENCE-GROUPS should be a number of lists containing
operators grouped by operator precedence (in order of precedence
from highest to lowest). A single operator is represented by a
list of at least two elements: operator name (symbol) and
operator arity (:unary or :binary). Optionally a custom
expression can be included, which defines how the operator is
expanded into an SQL expression (there are two defaults, one for
:unary and one for :binary operators).
An example for OPERATOR-PRECEDENCE-GROUPS:
\(((+ :unary (\"+\" :operand)) (- :unary (\"-\" :operand)))
((+ :binary) (- :binary)))"
`(defun ,name (operator-name operator-argument-count)
"Look up predefined SQL operator metadata.
See `emacsql--generate-op-lookup-defun' for details."
(cond
,@(cl-loop
for precedence-value from 1
for precedence-group in (reverse operator-precedence-groups)
append (cl-loop
for (op-name arity custom-expr) in precedence-group
for sql-name = (upcase (symbol-name op-name))
for sql-expr =
(or custom-expr
(pcase arity
(:unary `(,sql-name " " :operand))
(:binary `(:operand " " ,sql-name " " :operand))))
collect (list `(and (eq operator-name
(quote ,op-name))
,(if (eq arity :unary)
`(eql operator-argument-count 1)
`(>= operator-argument-count 2)))
`(list ',sql-expr ,arity ,precedence-value))))
(t (list nil nil nil)))))
(emacsql--generate-op-lookup-defun
emacsql--get-op
(((~ :unary ("~" :operand)))
((collate :binary))
((|| :binary))
((* :binary) (/ :binary) (% :binary))
((+ :unary ("+" :operand)) (- :unary ("-" :operand)))
((+ :binary) (- :binary))
((& :binary) (| :binary) (<< :binary) (>> :binary))
((escape :binary (:operand " ESCAPE " :operand)))
((< :binary) (<= :binary) (> :binary) (>= :binary))
(;;TODO? (between :binary) (not-between :binary)
(is :binary) (is-not :binary (:operand " IS NOT " :operand))
(match :binary) (not-match :binary (:operand " NOT MATCH " :operand))
(like :binary) (not-like :binary (:operand " NOT LIKE " :operand))
(in :binary) (not-in :binary (:operand " NOT IN " :operand))
(isnull :unary (:operand " ISNULL"))
(notnull :unary (:operand " NOTNULL"))
(= :binary) (== :binary)
(!= :binary) (<> :binary)
(glob :binary) (not-glob :binary (:operand " NOT GLOB " :operand))
(regexp :binary) (not-regexp :binary (:operand " NOT REGEXP " :operand)))
((not :unary))
((and :binary))
((or :binary))))
(defun emacsql--expand-format-string (op expr arity argument-count)
"Create format-string for an SQL operator.
The format-string returned is intended to be used with `format'
to create an SQL expression."
(and expr
(cl-labels ((replace-operand (x) (if (eq x :operand) "%s" x))
(to-format-string (e) (mapconcat #'replace-operand e "")))
(cond
((and (eq arity :unary) (eql argument-count 1))
(to-format-string expr))
((and (eq arity :binary) (>= argument-count 2))
(let ((result (reverse expr)))
(dotimes (_ (- argument-count 2))
(setq result (nconc (reverse expr) (cdr result))))
(to-format-string (nreverse result))))
(t (emacsql-error "Wrong number of operands for %s" op))))))
(defun emacsql--get-op-info (op argument-count parent-precedence-value)
"Lookup SQL operator information for generating an SQL expression.
Returns the following multiple values when an operator can be
identified: a format string (see `emacsql--expand-format-string')
and a precedence value. If PARENT-PRECEDENCE-VALUE is greater or
equal to the identified operator's precedence, then the format
string returned is wrapped with parentheses."
(cl-destructuring-bind (format-string arity precedence-value)
(emacsql--get-op op argument-count)
(let ((expanded-format-string
(emacsql--expand-format-string
op
format-string
arity
argument-count)))
(cl-values (cond
((null format-string) nil)
((>= parent-precedence-value
precedence-value)
(format "(%s)" expanded-format-string))
(t expanded-format-string))
precedence-value))))
(defun emacsql--*expr (expr &optional parent-precedence-value)
"Expand EXPR recursively."
(emacsql-with-params ""
(cond
((emacsql-sql-p expr) (subsql expr))
((vectorp expr) (svector expr))
((atom expr) (param expr))
((cl-destructuring-bind (op . args) expr
(cl-multiple-value-bind (format-string precedence-value)
(emacsql--get-op-info op
(length args)
(or parent-precedence-value 0))
(cl-flet ((recur (n)
(combine (emacsql--*expr (nth n args)
(or precedence-value 0))))
(nops (op)
(emacsql-error "Wrong number of operands for %s" op)))
(cl-case op
;; Special cases <= >=
((<= >=)
(cl-case (length args)
(2 (format format-string (recur 0) (recur 1)))
(3 (format (if (>= (or parent-precedence-value 0)
precedence-value)
"(%s BETWEEN %s AND %s)"
"%s BETWEEN %s AND %s")
(recur 1)
(recur (if (eq op '>=) 2 0))
(recur (if (eq op '>=) 0 2))))
(otherwise (nops op))))
;; enforce second argument to be a character
((escape)
(let ((second-arg (cadr args)))
(cond
((not (= 2 (length args))) (nops op))
((not (characterp second-arg))
(emacsql-error
"Second operand of escape has to be a character, got %s"
second-arg))
(t (format format-string
(recur 0)
(emacsql-quote-character second-arg))))))
;; Ordering
((asc desc)
(format "%s %s" (recur 0) (upcase (symbol-name op))))
;; Special case quote
((quote) (let ((arg (nth 0 args)))
(if (stringp arg)
(raw arg)
(scalar arg))))
;; Special case funcall
((funcall)
(format "%s(%s)" (recur 0)
(cond
((and (= 2 (length args))
(eq '* (nth 1 args)))
"*")
((and (= 3 (length args))
(eq :distinct (nth 1 args))
(format "DISTINCT %s" (recur 2))))
((mapconcat
#'recur (cl-loop for i from 1 below (length args)
collect i)
", ")))))
;; Guess
(otherwise
(let ((arg-indices (cl-loop for i from 0 below (length args) collect i)))
(if format-string
(apply #'format format-string (mapcar #'recur arg-indices))
(mapconcat
#'recur (cl-loop for i from 0 below (length args) collect i)
(format " %s " (upcase (symbol-name op)))))))))))))))
(defun emacsql--*idents (idents)
"Read in a vector of IDENTS identifiers, or just an single identifier."
(emacsql-with-params ""
(mapconcat #'expr idents ", ")))
(defun emacsql--*combine (prepared)
"Append parameters from PREPARED to `emacsql--vars', return the string.
Only use within `emacsql-with-params'!"
(cl-destructuring-bind (string . vars) prepared
(setq emacsql--vars (nconc emacsql--vars vars))
string))
(defun emacsql-prepare--string (string)
"Create a prepared statement from STRING."
(emacsql-with-params ""
(replace-regexp-in-string
"\\$[isv][0-9]+" (lambda (v) (param (intern v))) string)))
(defun emacsql-prepare--sexp (sexp)
"Create a prepared statement from SEXP."
(emacsql-with-params ""
(cl-loop with items = (cl-coerce sexp 'list)
and last = nil
while (not (null items))
for item = (pop items)
collect
(cl-typecase item
(keyword (if (eq :values item)
(concat "VALUES " (svector (pop items)))
(emacsql--from-keyword item)))
(symbol (if (eq item '*)
"*"
(param item)))
(vector (if (emacsql-sql-p item)
(subsql item)
(let ((idents (combine
(emacsql--*idents item))))
(if (keywordp last)
idents
(format "(%s)" idents)))))
(list (if (vectorp (car item))
(emacsql-escape-format
(format "(%s)"
(emacsql-prepare-schema item)))
(combine (emacsql--*expr item))))
(otherwise
(emacsql-escape-format
(emacsql-escape-scalar item))))
into parts
do (setq last item)
finally (cl-return (string-join parts " ")))))
(defun emacsql-prepare (sql)
"Expand SQL (string or sexp) into a prepared statement."
(let* ((cache emacsql-prepare-cache)
(key (cons emacsql-type-map sql)))
(or (gethash key cache)
(setf (gethash key cache)
(if (stringp sql)
(emacsql-prepare--string sql)
(emacsql-prepare--sexp sql))))))
(defun emacsql-format (expansion &rest args)
"Fill in the variables EXPANSION with ARGS."
(cl-destructuring-bind (format . vars) expansion
(let ((print-level nil)
(print-length nil))
(apply #'format format
(cl-loop for (i . kind) in vars collect
(let ((thing (nth i args)))
(cl-case kind
(:identifier (emacsql-escape-identifier thing))
(:scalar (emacsql-escape-scalar thing))
(:vector (emacsql-escape-vector thing))
(:raw (emacsql-escape-raw thing))
(:schema (emacsql-prepare-schema thing))
(otherwise
(emacsql-error "Invalid var type %S" kind)))))))))
(provide 'emacsql-compiler)
;;; emacsql-compiler.el ends here
================================================
FILE: emacsql-mysql.el
================================================
;;; emacsql-mysql.el --- EmacSQL back-end for MySQL -*- lexical-binding:t -*-
;; This is free and unencumbered software released into the public domain.
;; Author: Christopher Wellons <wellons@nullprogram.com>
;; Maintainer: Jonas Bernoulli <emacs.emacsql@jonas.bernoulli.dev>
;; SPDX-License-Identifier: Unlicense
;;; Commentary:
;; This library provides an EmacSQL back-end for MySQL, which uses
;; the standard `msql' command line program.
;;; Code:
(require 'emacsql)
(defvar emacsql-mysql-executable "mysql"
"Path to the mysql command line executable.")
(defvar emacsql-mysql-sentinel "--------------\n\n--------------\n\n"
"What MySQL will print when it has completed its output.")
(defconst emacsql-mysql-reserved
(emacsql-register-reserved
'( ACCESSIBLE ADD ALL ALTER ANALYZE AND AS ASC ASENSITIVE BEFORE
BETWEEN BIGINT BINARY BLOB BOTH BY CALL CASCADE CASE CHANGE CHAR
CHARACTER CHECK COLLATE COLUMN CONDITION CONSTRAINT CONTINUE
CONVERT CREATE CROSS CURRENT_DATE CURRENT_TIME CURRENT_TIMESTAMP
CURRENT_USER CURSOR DATABASE DATABASES DAY_HOUR DAY_MICROSECOND
DAY_MINUTE DAY_SECOND DEC DECIMAL DECLARE DEFAULT DELAYED DELETE
DESC DESCRIBE DETERMINISTIC DISTINCT DISTINCTROW DIV DOUBLE DROP
DUAL EACH ELSE ELSEIF ENCLOSED ESCAPED EXISTS EXIT EXPLAIN FALSE
FETCH FLOAT FLOAT4 FLOAT8 FOR FORCE FOREIGN FROM FULLTEXT GENERAL
GRANT GROUP HAVING HIGH_PRIORITY HOUR_MICROSECOND HOUR_MINUTE
HOUR_SECOND IF IGNORE IGNORE_SERVER_IDS IN INDEX INFILE INNER
INOUT INSENSITIVE INSERT INT INT1 INT2 INT3 INT4 INT8 INTEGER
INTERVAL INTO IS ITERATE JOIN KEY KEYS KILL LEADING LEAVE LEFT
LIKE LIMIT LINEAR LINES LOAD LOCALTIME LOCALTIMESTAMP LOCK LONG
LONGBLOB LONGTEXT LOOP LOW_PRIORITY MASTER_HEARTBEAT_PERIOD
MASTER_SSL_VERIFY_SERVER_CERT MATCH MAXVALUE MAXVALUE MEDIUMBLOB
MEDIUMINT MEDIUMTEXT MIDDLEINT MINUTE_MICROSECOND MINUTE_SECOND
MOD MODIFIES NATURAL NOT NO_WRITE_TO_BINLOG NULL NUMERIC ON
OPTIMIZE OPTION OPTIONALLY OR ORDER OUT OUTER OUTFILE PRECISION
PRIMARY PROCEDURE PURGE RANGE READ READS READ_WRITE REAL
REFERENCES REGEXP RELEASE RENAME REPEAT REPLACE REQUIRE RESIGNAL
RESIGNAL RESTRICT RETURN REVOKE RIGHT RLIKE SCHEMA SCHEMAS
SECOND_MICROSECOND SELECT SENSITIVE SEPARATOR SET SHOW SIGNAL
SIGNAL SLOW SMALLINT SPATIAL SPECIFIC SQL SQL_BIG_RESULT
SQL_CALC_FOUND_ROWS SQLEXCEPTION SQL_SMALL_RESULT SQLSTATE
SQLWARNING SSL STARTING STRAIGHT_JOIN TABLE TERMINATED THEN
TINYBLOB TINYINT TINYTEXT TO TRAILING TRIGGER TRUE UNDO UNION
UNIQUE UNLOCK UNSIGNED UPDATE USAGE USE USING UTC_DATE UTC_TIME
UTC_TIMESTAMP VALUES VARBINARY VARCHAR VARCHARACTER VARYING WHEN
WHERE WHILE WITH WRITE XOR YEAR_MONTH ZEROFILL))
"List of all of MySQL's reserved words.
http://dev.mysql.com/doc/refman/5.5/en/reserved-words.html")
(defclass emacsql-mysql-connection (emacsql-connection)
((dbname :reader emacsql-psql-dbname :initarg :dbname)
(types :allocation :class
:reader emacsql-types
:initform '((integer "BIGINT")
(float "DOUBLE")
(object "LONGTEXT")
(nil "LONGTEXT"))))
"A connection to a MySQL database.")
(cl-defun emacsql-mysql (database &key user password host port debug)
"Connect to a MySQL server using the mysql command line program."
(let* ((mysql (or (executable-find emacsql-mysql-executable)
(error "No mysql binary available, aborting")))
(command (list database "--skip-pager" "-rfBNL" mysql)))
(when user (push (format "--user=%s" user) command))
(when password (push (format "--password=%s" password) command))
(when host (push (format "--host=%s" host) command))
(when port (push (format "--port=%s" port) command))
(let* ((process-connection-type t)
(buffer (generate-new-buffer " *emacsql-mysql*"))
(command (mapconcat #'shell-quote-argument (nreverse command) " "))
(process (start-process-shell-command
"emacsql-mysql" buffer (concat "stty raw &&" command)))
(connection (make-instance 'emacsql-mysql-connection
:handle process
:dbname database)))
(set-process-sentinel process
(lambda (proc _) (kill-buffer (process-buffer proc))))
(set-process-query-on-exit-flag (oref connection handle) nil)
(when debug (emacsql-enable-debugging connection))
(emacsql connection
[:set-session (= sql-mode 'NO_BACKSLASH_ESCAPES\,ANSI_QUOTES)])
(emacsql connection
[:set-transaction-isolation-level :serializable])
(emacsql-register connection))))
(cl-defmethod emacsql-close ((connection emacsql-mysql-connection))
(let ((process (oref connection handle)))
(when (process-live-p process)
(process-send-eof process))))
(cl-defmethod emacsql-send-message ((connection emacsql-mysql-connection) message)
(let ((process (oref connection handle)))
(process-send-string process message)
(process-send-string process "\\c\\p\n")))
(cl-defmethod emacsql-waiting-p ((connection emacsql-mysql-connection))
(let ((length (length emacsql-mysql-sentinel)))
(with-current-buffer (emacsql-buffer connection)
(and (>= (buffer-size) length)
(progn (goto-char (- (point-max) length))
(looking-at emacsql-mysql-sentinel))))))
(cl-defmethod emacsql-parse ((connection emacsql-mysql-connection))
(with-current-buffer (emacsql-buffer connection)
(let ((standard-input (current-buffer)))
(goto-char (point-min))
(when (looking-at "ERROR")
(search-forward ": ")
(signal 'emacsql-error
(list (buffer-substring (point) (line-end-position)))))
(cl-loop until (looking-at emacsql-mysql-sentinel)
collect (read) into row
when (looking-at "\n")
collect row into rows
and do (setq row ())
and do (forward-char)
finally (cl-return rows)))))
(provide 'emacsql-mysql)
;;; emacsql-mysql.el ends here
================================================
FILE: emacsql-pg.el
================================================
;;; emacsql-pg.el --- EmacSQL back-end for PostgreSQL via pg -*- lexical-binding:t -*-
;; This is free and unencumbered software released into the public domain.
;; Author: Christopher Wellons <wellons@nullprogram.com>
;; Maintainer: Jonas Bernoulli <emacs.emacsql@jonas.bernoulli.dev>
;; SPDX-License-Identifier: Unlicense
;;; Commentary:
;; This library provides an EmacSQL back-end for PostgreSQL, which
;; uses the `pg' package to directly speak to the database. This
;; library requires at least Emacs 28.1.
;; (For an alternative back-end for PostgreSQL, see `emacsql-psql'.)
;;; Code:
(require 'emacsql)
(if (>= emacs-major-version 28)
(require 'pg nil t)
(message "emacsql-pg.el requires Emacs 28.1 or later"))
(declare-function pg-connect "ext:pg"
( dbname user &optional
(password "") (host "localhost") (port 5432) (tls nil)))
(declare-function pg-disconnect "ext:pg" (con))
(declare-function pg-exec "ext:pg" (connection &rest args))
(declare-function pg-result "ext:pg" (result what &rest arg))
(defclass emacsql-pg-connection (emacsql-connection)
((pgcon :reader emacsql-pg-pgcon :initarg :pgcon)
(dbname :reader emacsql-pg-dbname :initarg :dbname)
(result :accessor emacsql-pg-result)
(types :allocation :class
:reader emacsql-types
:initform '((integer "BIGINT")
(float "DOUBLE PRECISION")
(object "TEXT")
(nil "TEXT"))))
"A connection to a PostgreSQL database via pg.el.")
(cl-defun emacsql-pg (dbname user &key
(host "localhost") (password "") (port 5432) debug)
"Connect to a PostgreSQL server using pg.el."
(require 'pg)
(let* ((pgcon (pg-connect dbname user password host port))
(connection (make-instance 'emacsql-pg-connection
:handle (and (fboundp 'pgcon-process)
(pgcon-process pgcon))
:pgcon pgcon
:dbname dbname)))
(when debug (emacsql-enable-debugging connection))
(emacsql connection [:set (= default-transaction-isolation 'SERIALIZABLE)])
(emacsql-register connection)))
(cl-defmethod emacsql-close ((connection emacsql-pg-connection))
(ignore-errors (pg-disconnect (emacsql-pg-pgcon connection))))
(cl-defmethod emacsql-send-message ((connection emacsql-pg-connection) message)
(condition-case error
(setf (emacsql-pg-result connection)
(pg-exec (emacsql-pg-pgcon connection) message))
(error (signal 'emacsql-error error))))
(cl-defmethod emacsql-waiting-p ((_connection emacsql-pg-connection))
;; pg-exec will block
t)
(cl-defmethod emacsql-parse ((connection emacsql-pg-connection))
(let ((tuples (pg-result (emacsql-pg-result connection) :tuples)))
(cl-loop for tuple in tuples collect
(cl-loop for value in tuple
when (stringp value) collect (read value)
else collect value))))
(provide 'emacsql-pg)
;;; emacsql-pg.el ends here
================================================
FILE: emacsql-psql.el
================================================
;;; emacsql-psql.el --- EmacSQL back-end for PostgreSQL via psql -*- lexical-binding:t -*-
;; This is free and unencumbered software released into the public domain.
;; Author: Christopher Wellons <wellons@nullprogram.com>
;; Maintainer: Jonas Bernoulli <emacs.emacsql@jonas.bernoulli.dev>
;; SPDX-License-Identifier: Unlicense
;;; Commentary:
;; This library provides an EmacSQL back-end for PostgreSQL, which
;; uses the standard `psql' command line program.
;; (For an alternative back-end for PostgreSQL, see `emacsql-pg'.)
;;; Code:
(require 'emacsql)
(defvar emacsql-psql-executable "psql"
"Path to the psql (PostgreSQL client) executable.")
(defun emacsql-psql-unavailable-p ()
"Return a reason if the psql executable is not available.
:no-executable -- cannot find the executable
:cannot-execute -- cannot run the executable
:old-version -- sqlite3 version is too old"
(let ((psql emacsql-psql-executable))
(if (null (executable-find psql))
:no-executable
(condition-case _
(with-temp-buffer
(call-process psql nil (current-buffer) nil "--version")
(let ((version (cl-third (split-string (buffer-string)))))
(if (version< version "1.0.0")
:old-version
nil)))
(error :cannot-execute)))))
(defconst emacsql-psql-reserved
(emacsql-register-reserved
'( ALL ANALYSE ANALYZE AND ANY AS ASC AUTHORIZATION BETWEEN BINARY
BOTH CASE CAST CHECK COLLATE COLUMN CONSTRAINT CREATE CROSS
CURRENT_DATE CURRENT_TIME CURRENT_TIMESTAMP CURRENT_USER DEFAULT
DEFERRABLE DESC DISTINCT DO ELSE END EXCEPT FALSE FOR FOREIGN
FREEZE FROM FULL GRANT GROUP HAVING ILIKE IN INITIALLY INNER
INTERSECT INTO IS ISNULL JOIN LEADING LEFT LIKE LIMIT LOCALTIME
LOCALTIMESTAMP NATURAL NEW NOT NOTNULL NULL OFF OFFSET OLD ON
ONLY OR ORDER OUTER OVERLAPS PLACING PRIMARY REFERENCES RIGHT
SELECT SESSION_USER SIMILAR SOME TABLE THEN TO TRAILING TRUE
UNION UNIQUE USER USING VERBOSE WHEN WHERE))
"List of all of PostgreSQL's reserved words.
http://www.postgresql.org/docs/7.3/static/sql-keywords-appendix.html")
(defclass emacsql-psql-connection (emacsql-connection)
((dbname :reader emacsql-psql-dbname :initarg :dbname)
(types :allocation :class
:reader emacsql-types
:initform '((integer "BIGINT")
(float "DOUBLE PRECISION")
(object "TEXT")
(nil "TEXT"))))
"A connection to a PostgreSQL database via psql.")
(cl-defun emacsql-psql (dbname &key username hostname port debug)
"Connect to a PostgreSQL server using the psql command line program."
(let ((args (list dbname)))
(when username
(push username args))
(push "-n" args)
(when port
(push "-p" args)
(push port args))
(when hostname
(push "-h" args)
(push hostname args))
(setq args (nreverse args))
(let* ((buffer (generate-new-buffer " *emacsql-psql*"))
(psql emacsql-psql-executable)
(command (mapconcat #'shell-quote-argument (cons psql args) " "))
(process (start-process-shell-command
"emacsql-psql" buffer (concat "stty raw && " command)))
(connection (make-instance 'emacsql-psql-connection
:handle process
:dbname dbname)))
(setf (process-sentinel process)
(lambda (proc _) (kill-buffer (process-buffer proc))))
(set-process-query-on-exit-flag (oref connection handle) nil)
(when debug (emacsql-enable-debugging connection))
(mapc (apply-partially #'emacsql-send-message connection)
'("\\pset pager off"
"\\pset null nil"
"\\a"
"\\t"
"\\f ' '"
"SET client_min_messages TO ERROR;"
"\\set PROMPT1 ]"
"EMACSQL;")) ; error message flush
(emacsql-wait connection)
(emacsql connection
[:set (= default-transaction-isolation 'SERIALIZABLE)])
(emacsql-register connection))))
(cl-defmethod emacsql-close ((connection emacsql-psql-connection))
(let ((process (oref connection handle)))
(when (process-live-p process)
(process-send-string process "\\q\n"))))
(cl-defmethod emacsql-send-message ((connection emacsql-psql-connection) message)
(let ((process (oref connection handle)))
(process-send-string process message)
(process-send-string process "\n")))
(cl-defmethod emacsql-waiting-p ((connection emacsql-psql-connection))
(with-current-buffer (emacsql-buffer connection)
(cond ((= (buffer-size) 1) (string= "]" (buffer-string)))
((> (buffer-size) 1) (string= "\n]" (buffer-substring
(- (point-max) 2)
(point-max)))))))
(cl-defmethod emacsql-check-error ((connection emacsql-psql-connection))
(with-current-buffer (emacsql-buffer connection)
(let ((case-fold-search t))
(goto-char (point-min))
(when (looking-at "error:")
(let* ((beg (line-beginning-position))
(end (line-end-position)))
(signal 'emacsql-error (list (buffer-substring beg end))))))))
(cl-defmethod emacsql-parse ((connection emacsql-psql-connection))
(emacsql-check-error connection)
(with-current-buffer (emacsql-buffer connection)
(let ((standard-input (current-buffer)))
(goto-char (point-min))
(cl-loop until (looking-at "]")
collect (read) into row
when (looking-at "\n")
collect row into rows
and do (progn (forward-char 1) (setq row ()))
finally (cl-return rows)))))
(provide 'emacsql-psql)
;;; emacsql-psql.el ends here
================================================
FILE: emacsql-sqlite-builtin.el
================================================
;;; emacsql-sqlite-builtin.el --- EmacSQL back-end for SQLite using builtin support -*- lexical-binding:t -*-
;; This is free and unencumbered software released into the public domain.
;; Author: Jonas Bernoulli <emacs.emacsql@jonas.bernoulli.dev>
;; Maintainer: Jonas Bernoulli <emacs.emacsql@jonas.bernoulli.dev>
;; SPDX-License-Identifier: Unlicense
;;; Commentary:
;; This library provides an EmacSQL back-end for SQLite, which uses
;; the built-in SQLite support in Emacs 29 an later.
;;; Code:
(require 'emacsql-sqlite)
(declare-function sqlite-open "sqlite.c")
(declare-function sqlite-select "sqlite.c")
(declare-function sqlite-close "sqlite.c")
(emacsql-register-reserved emacsql-sqlite-reserved)
(defclass emacsql-sqlite-builtin-connection (emacsql--sqlite-base) ()
"A connection to a SQLite database using builtin support.")
(cl-defmethod initialize-instance :after
((connection emacsql-sqlite-builtin-connection) &rest _)
(oset connection handle
(sqlite-open (oref connection file)))
(emacsql-sqlite-set-busy-timeout connection)
(emacsql connection [:pragma (= foreign-keys on)])
(emacsql-register connection))
(cl-defun emacsql-sqlite-builtin (file &key debug)
"Open a connected to database stored in FILE.
If FILE is nil use an in-memory database.
:debug LOG -- When non-nil, log all SQLite commands to a log
buffer. This is for debugging purposes."
(let ((connection (make-instance #'emacsql-sqlite-builtin-connection
:file file)))
(when debug
(emacsql-enable-debugging connection))
connection))
(cl-defmethod emacsql-live-p ((connection emacsql-sqlite-builtin-connection))
(and (oref connection handle) t))
(cl-defmethod emacsql-close ((connection emacsql-sqlite-builtin-connection))
(when (oref connection handle)
(sqlite-close (oref connection handle))
(oset connection handle nil)))
(cl-defmethod emacsql-send-message
((connection emacsql-sqlite-builtin-connection) message)
(condition-case err
(let ((headerp emacsql-include-header))
(mapcar (lambda (row)
(cond
(headerp (setq headerp nil) row)
((mapcan (lambda (col)
(cond ((null col) (list nil))
((equal col "") (list ""))
((numberp col) (list col))
((emacsql-sqlite-read-column col))))
row))))
(sqlite-select (oref connection handle) message nil
(and emacsql-include-header 'full))))
((sqlite-error sqlite-locked-error)
(if (stringp (cdr err))
(signal 'emacsql-error (list (cdr err)))
(pcase-let* ((`(,_ ,errstr ,errmsg ,errcode ,ext-errcode) err)
(`(,_ ,_ ,signal ,_)
(assq errcode emacsql-sqlite-error-codes)))
(signal (or signal 'emacsql-error)
(list errmsg errcode ext-errcode errstr)))))
(error
(signal 'emacsql-error (cdr err)))))
(cl-defmethod emacsql ((connection emacsql-sqlite-builtin-connection) sql &rest args)
(emacsql-send-message connection (apply #'emacsql-compile connection sql args)))
(provide 'emacsql-sqlite-builtin)
;;; emacsql-sqlite-builtin.el ends here
================================================
FILE: emacsql-sqlite-module.el
================================================
;;; emacsql-sqlite-module.el --- EmacSQL back-end for SQLite using a module -*- lexical-binding:t -*-
;; This is free and unencumbered software released into the public domain.
;; Author: Jonas Bernoulli <emacs.emacsql@jonas.bernoulli.dev>
;; Maintainer: Jonas Bernoulli <emacs.emacsql@jonas.bernoulli.dev>
;; SPDX-License-Identifier: Unlicense
;;; Commentary:
;; This library provides an EmacSQL back-end for SQLite, which uses
;; the Emacs module provided by the `sqlite3' package.
;;; Code:
(require 'emacsql-sqlite)
(require 'sqlite3 nil t)
;; Prevent check-declare from finding the defining file but then making
;; noise because it fails to find the definition because it is a module.
(declare-function sqlite3-open "ext:module:sqlite3-api")
(declare-function sqlite3-exec "ext:module:sqlite3-api")
(declare-function sqlite3-close "ext:module:sqlite3-api")
(defvar sqlite-open-readwrite)
(defvar sqlite-open-create)
(emacsql-register-reserved emacsql-sqlite-reserved)
(defclass emacsql-sqlite-module-connection (emacsql--sqlite-base) ()
"A connection to a SQLite database using a module.")
(cl-defmethod initialize-instance :after
((connection emacsql-sqlite-module-connection) &rest _)
(require (quote sqlite3))
(oset connection handle
(sqlite3-open (or (oref connection file) ":memory:")
sqlite-open-readwrite
sqlite-open-create))
(emacsql-sqlite-set-busy-timeout connection)
(emacsql connection [:pragma (= foreign-keys on)])
(emacsql-register connection))
(cl-defun emacsql-sqlite-module (file &key debug)
"Open a connected to database stored in FILE.
If FILE is nil use an in-memory database.
:debug LOG -- When non-nil, log all SQLite commands to a log
buffer. This is for debugging purposes."
(let ((connection (make-instance #'emacsql-sqlite-module-connection
:file file)))
(when debug
(emacsql-enable-debugging connection))
connection))
(cl-defmethod emacsql-live-p ((connection emacsql-sqlite-module-connection))
(and (oref connection handle) t))
(cl-defmethod emacsql-close ((connection emacsql-sqlite-module-connection))
(when (oref connection handle)
(sqlite3-close (oref connection handle))
(oset connection handle nil)))
(cl-defmethod emacsql-send-message
((connection emacsql-sqlite-module-connection) message)
(condition-case err
(let ((include-header emacsql-include-header)
(rows ()))
(sqlite3-exec (oref connection handle)
message
(lambda (_ row header)
(when include-header
(push header rows)
(setq include-header nil))
(push (mapcan (lambda (col)
(cond
((null col) (list nil))
((equal col "") (list ""))
((emacsql-sqlite-read-column col))))
row)
rows)))
(nreverse rows))
((db-error sql-error)
(pcase-let* ((`(,_ ,errmsg ,errcode) err)
(`(,_ ,_ ,signal ,errstr)
(assq errcode emacsql-sqlite-error-codes)))
(signal (or signal 'emacsql-error)
(list errmsg errcode nil errstr))))
(error
(signal 'emacsql-error (cdr err)))))
(cl-defmethod emacsql ((connection emacsql-sqlite-module-connection) sql &rest args)
(emacsql-send-message connection (apply #'emacsql-compile connection sql args)))
(provide 'emacsql-sqlite-module)
;;; emacsql-sqlite-module.el ends here
================================================
FILE: emacsql-sqlite.el
================================================
;;; emacsql-sqlite.el --- Code used by both SQLite back-ends -*- lexical-binding:t -*-
;; This is free and unencumbered software released into the public domain.
;; Author: Jonas Bernoulli <emacs.emacsql@jonas.bernoulli.dev>
;; Maintainer: Jonas Bernoulli <emacs.emacsql@jonas.bernoulli.dev>
;; SPDX-License-Identifier: Unlicense
;;; Commentary:
;; This library contains code that is used by both SQLite back-ends.
;;; Code:
(require 'emacsql)
;;; Base class
(defclass emacsql--sqlite-base (emacsql-connection)
((file :initarg :file
:initform nil
:type (or null string)
:documentation "Database file name.")
(types :allocation :class
:reader emacsql-types
:initform '((integer "INTEGER")
(float "REAL")
(object "TEXT")
(nil nil))))
:abstract t)
;;; Constants
(defconst emacsql-sqlite-reserved
'( ABORT ACTION ADD AFTER ALL ALTER ANALYZE AND AS ASC ATTACH
AUTOINCREMENT BEFORE BEGIN BETWEEN BY CASCADE CASE CAST CHECK
COLLATE COLUMN COMMIT CONFLICT CONSTRAINT CREATE CROSS
CURRENT_DATE CURRENT_TIME CURRENT_TIMESTAMP DATABASE DEFAULT
DEFERRABLE DEFERRED DELETE DESC DETACH DISTINCT DROP EACH ELSE END
ESCAPE EXCEPT EXCLUSIVE EXISTS EXPLAIN FAIL FOR FOREIGN FROM FULL
GLOB GROUP HAVING IF IGNORE IMMEDIATE IN INDEX INDEXED INITIALLY
INNER INSERT INSTEAD INTERSECT INTO IS ISNULL JOIN KEY LEFT LIKE
LIMIT MATCH NATURAL NO NOT NOTNULL NULL OF OFFSET ON OR ORDER
OUTER PLAN PRAGMA PRIMARY QUERY RAISE RECURSIVE REFERENCES REGEXP
REINDEX RELEASE RENAME REPLACE RESTRICT RIGHT ROLLBACK ROW
SAVEPOINT SELECT SET TABLE TEMP TEMPORARY THEN TO TRANSACTION
TRIGGER UNION UNIQUE UPDATE USING VACUUM VALUES VIEW VIRTUAL WHEN
WHERE WITH WITHOUT)
"List of all of SQLite's reserved words.
Also see http://www.sqlite.org/lang_keywords.html.")
(defconst emacsql-sqlite-error-codes
'((1 SQLITE_ERROR emacsql-error "SQL logic error")
(2 SQLITE_INTERNAL emacsql-internal nil)
(3 SQLITE_PERM emacsql-access "access permission denied")
(4 SQLITE_ABORT emacsql-error "query aborted")
(5 SQLITE_BUSY emacsql-locked "database is locked")
(6 SQLITE_LOCKED emacsql-locked "database table is locked")
(7 SQLITE_NOMEM emacsql-memory "out of memory")
(8 SQLITE_READONLY emacsql-access "attempt to write a readonly database")
(9 SQLITE_INTERRUPT emacsql-error "interrupted")
(10 SQLITE_IOERR emacsql-access "disk I/O error")
(11 SQLITE_CORRUPT emacsql-corruption "database disk image is malformed")
(12 SQLITE_NOTFOUND emacsql-error "unknown operation")
(13 SQLITE_FULL emacsql-access "database or disk is full")
(14 SQLITE_CANTOPEN emacsql-access "unable to open database file")
(15 SQLITE_PROTOCOL emacsql-access "locking protocol")
(16 SQLITE_EMPTY emacsql-corruption nil)
(17 SQLITE_SCHEMA emacsql-error "database schema has changed")
(18 SQLITE_TOOBIG emacsql-error "string or blob too big")
(19 SQLITE_CONSTRAINT emacsql-constraint "constraint failed")
(20 SQLITE_MISMATCH emacsql-error "datatype mismatch")
(21 SQLITE_MISUSE emacsql-error "bad parameter or other API misuse")
(22 SQLITE_NOLFS emacsql-error "large file support is disabled")
(23 SQLITE_AUTH emacsql-access "authorization denied")
(24 SQLITE_FORMAT emacsql-corruption nil)
(25 SQLITE_RANGE emacsql-error "column index out of range")
(26 SQLITE_NOTADB emacsql-corruption "file is not a database")
(27 SQLITE_NOTICE emacsql-warning "notification message")
(28 SQLITE_WARNING emacsql-warning "warning message"))
"Alist mapping SQLite error codes to EmacSQL conditions.
Elements have the form (ERRCODE SYMBOLIC-NAME EMACSQL-ERROR
ERRSTR). Also see https://www.sqlite.org/rescode.html.")
;;; Variables
(defvar emacsql-include-header nil
"Whether to include names of columns as an additional row.
Never enable this globally, only let-bind it around calls to `emacsql'.
Currently only supported by `emacsql-sqlite-builtin-connection' and
`emacsql-sqlite-module-connection'.")
(defvar emacsql-sqlite-busy-timeout 20
"Seconds to wait when trying to access a table blocked by another process.
See https://www.sqlite.org/c3ref/busy_timeout.html.")
;;; Utilities
(defun emacsql-sqlite-connection (variable file &optional setup use-module)
"Return the connection stored in VARIABLE to the database in FILE.
If the value of VARIABLE is a live database connection, return that.
Otherwise open a new connection to the database in FILE and store the
connection in VARIABLE, before returning it. If FILE is nil, use an
in-memory database. Always enable support for foreign key constrains.
If optional SETUP is non-nil, it must be a function, which takes the
connection as only argument. This function can be used to initialize
tables, for example.
If optional USE-MODULE is non-nil, then use the external module even
when Emacs was built with SQLite support. This is intended for testing
purposes."
(or (let ((connection (symbol-value variable)))
(and connection (emacsql-live-p connection) connection))
(set variable (emacsql-sqlite-open file nil setup use-module))))
(defun emacsql-sqlite-open (file &optional debug setup use-module)
"Open a connection to the database stored in FILE using an SQLite back-end.
Automatically use the best available back-end, as returned by
`emacsql-sqlite-default-connection'.
If FILE is nil, use an in-memory database. If optional DEBUG is
non-nil, log all SQLite commands to a log buffer, for debugging
purposes. Always enable support for foreign key constrains.
If optional SETUP is non-nil, it must be a function, which takes the
connection as only argument. This function can be used to initialize
tables, for example.
If optional USE-MODULE is non-nil, then use the external module even
when Emacs was built with SQLite support. This is intended for testing
purposes."
(when file
(make-directory (file-name-directory file) t))
(let* ((class (emacsql-sqlite-default-connection use-module))
(connection (make-instance class :file file)))
(when debug
(emacsql-enable-debugging connection))
(emacsql connection [:pragma (= foreign-keys on)])
(when setup
(funcall setup connection))
connection))
(defun emacsql-sqlite-default-connection (&optional use-module)
"Determine and return the best SQLite connection class.
Signal an error if none of the connection classes can be used.
If optional USE-MODULE is non-nil, then use the external module even
when Emacs was built with SQLite support. This is intended for testing
purposes."
(or (and (not use-module)
(fboundp 'sqlite-available-p)
(sqlite-available-p)
(require 'emacsql-sqlite-builtin)
'emacsql-sqlite-builtin-connection)
(and (boundp 'module-file-suffix)
module-file-suffix
(condition-case nil
;; Failure modes:
;; 1. `libsqlite' shared library isn't available.
;; 2. User chooses to not compile `libsqlite'.
;; 3. `libsqlite' compilation fails.
(and (require 'sqlite3)
(require 'emacsql-sqlite-module)
'emacsql-sqlite-module-connection)
(error
(display-warning 'emacsql "\
Since your Emacs does not come with
built-in SQLite support [1], but does support C modules, we can
use an EmacSQL backend that relies on the third-party `sqlite3'
package [2].
Please install the `sqlite3' Elisp package using your preferred
Emacs package manager, and install the SQLite shared library
using your distribution's package manager. That package should
be named something like `libsqlite3' [3] and NOT just `sqlite3'.
The legacy backend, which uses a custom SQLite executable, has
been remove, so we can no longer fall back to that.
[1]: Supported since Emacs 29.1, provided it was not disabled
with `--without-sqlite3'.
[2]: https://github.com/pekingduck/emacs-sqlite3-api
[3]: On Debian https://packages.debian.org/buster/libsqlite3-0")
;; The buffer displaying the warning might immediately
;; be replaced by another buffer, before the user gets
;; a chance to see it. We cannot have that.
(let (fn)
(setq fn (lambda ()
(remove-hook 'post-command-hook fn)
(pop-to-buffer (get-buffer "*Warnings*"))))
(add-hook 'post-command-hook fn))
nil)))
(error "EmacSQL could not find or compile a back-end")))
(defun emacsql-sqlite-set-busy-timeout (connection)
(when emacsql-sqlite-busy-timeout
(emacsql connection [:pragma (= busy-timeout $s1)]
(* emacsql-sqlite-busy-timeout 1000))))
(defun emacsql-sqlite-read-column (string)
(let ((value nil)
(beg 0)
(end (length string)))
(while (< beg end)
(let ((v (read-from-string string beg)))
(push (car v) value)
(setq beg (cdr v))))
(nreverse value)))
(defun emacsql-sqlite-list-tables (connection)
"Return a list of symbols identifying tables in CONNECTION.
Tables whose names begin with \"sqlite_\", are not included
in the returned value."
(mapcar #'car
(emacsql connection
[:select name
;; The new name is `sqlite-schema', but this name
;; is supported by old and new SQLite versions.
;; See https://www.sqlite.org/schematab.html.
:from sqlite-master
:where (and (= type 'table)
(not-like name "sqlite_%"))
:order-by [(asc name)]])))
(defun emacsql-sqlite-dump-database (connection &optional versionp)
"Dump the database specified by CONNECTION to a file.
The dump file is placed in the same directory as the database
file and its name derives from the name of the database file.
The suffix is replaced with \".sql\" and if optional VERSIONP is
non-nil, then the database version (the `user_version' pragma)
and a timestamp are appended to the file name.
Dumping is done using the official `sqlite3' binary. If that is
not available and VERSIONP is non-nil, then the database file is
copied instead."
(let* ((version (caar (emacsql connection [:pragma user-version])))
(db (oref connection file))
(db (if (symbolp db) (symbol-value db) db))
(name (file-name-nondirectory db))
(output (concat (file-name-sans-extension db)
(and versionp
(concat (format "-v%s" version)
(format-time-string "-%Y%m%d-%H%M")))
".sql")))
(cond
((locate-file "sqlite3" exec-path)
(when (and (file-exists-p output) versionp)
(error "Cannot dump database; %s already exists" output))
(with-temp-file output
(message "Dumping %s database to %s..." name output)
(unless (zerop (save-excursion
(call-process "sqlite3" nil t nil db ".dump")))
(error "Failed to dump %s" db))
(when version
(insert (format "PRAGMA user_version=%s;\n" version)))
;; The output contains "PRAGMA foreign_keys=OFF;".
;; Change that to avoid alarming attentive users.
(when (re-search-forward "^PRAGMA foreign_keys=\\(OFF\\);" 1000 t)
(replace-match "ON" t t nil 1))
(message "Dumping %s database to %s...done" name output)))
(versionp
(setq output (concat (file-name-sans-extension output) ".db"))
(message "Cannot dump database because sqlite3 binary cannot be found")
(when (and (file-exists-p output) versionp)
(error "Cannot copy database; %s already exists" output))
(message "Copying %s database to %s..." name output)
(copy-file db output)
(message "Copying %s database to %s...done" name output))
((error "Cannot dump database; sqlite3 binary isn't available")))))
(defun emacsql-sqlite-restore-database (db dump)
"Restore database DB from DUMP.
DUMP is a file containing SQL statements. DB can be the file
in which the database is to be stored, or it can be a database
connection. In the latter case the current database is first
dumped to a new file and the connection is closed. Then the
database is restored from DUMP. No connection to the new
database is created."
(unless (stringp db)
(emacsql-sqlite-dump-database db t)
(emacsql-close (prog1 db (setq db (oref db file)))))
(with-temp-buffer
(unless (zerop (call-process "sqlite3" nil t nil db
(format ".read %s" dump)))
(error "Failed to read %s: %s" dump (buffer-string)))))
(provide 'emacsql-sqlite)
;;; emacsql-sqlite.el ends here
================================================
FILE: emacsql.el
================================================
;;; emacsql.el --- High-level SQL database front-end -*- lexical-binding:t -*-
;; This is free and unencumbered software released into the public domain.
;; Author: Christopher Wellons <wellons@nullprogram.com>
;; Maintainer: Jonas Bernoulli <emacs.emacsql@jonas.bernoulli.dev>
;; Homepage: https://github.com/magit/emacsql
;; Package-Version: 4.3.6
;; Package-Requires: ((emacs "26.1"))
;; SPDX-License-Identifier: Unlicense
;;; Commentary:
;; EmacSQL is a high-level Emacs Lisp front-end for SQLite.
;; PostgreSQL and MySQL are also supported, but use of these connectors
;; is not recommended.
;; Any readable lisp value can be stored as a value in EmacSQL,
;; including numbers, strings, symbols, lists, vectors, and closures.
;; EmacSQL has no concept of TEXT values; it's all just lisp objects.
;; The lisp object `nil' corresponds 1:1 with NULL in the database.
;; See README.md for much more complete documentation.
;;; Code:
(require 'cl-lib)
(require 'cl-generic)
(require 'eieio)
(require 'emacsql-compiler)
(defgroup emacsql nil
"The EmacSQL SQL database front-end."
:group 'comm)
(defconst emacsql-version "4.3.6")
(defvar emacsql-global-timeout 30
"Maximum number of seconds to wait before bailing out on a SQL command.
If nil, wait forever. This is used by the `mysql', `pg' and `psql'. It
is not being used by the `sqlite-builtin' and `sqlite-module' back-ends,
which respect `emacsql-sqlite-busy-timeout' instead.")
;;; Database connection
(defclass emacsql-connection ()
((handle :initarg :handle
:documentation "Internal connection handler.
The value is a record-like object and should not be accessed
directly. Depending on the concrete implementation, `type-of'
may return `process', `user-ptr' or `sqlite' for this value.")
(log-buffer :type (or null buffer)
:initarg :log-buffer
:initform nil
:documentation "Output log (debug).")
(finalizer :documentation "Object returned from `make-finalizer'.")
(types :allocation :class
:initform nil
:reader emacsql-types
:documentation "Maps EmacSQL types to SQL types."))
"A connection to a SQL database."
:abstract t)
(cl-defgeneric emacsql-close (connection)
"Close CONNECTION and free all resources.")
(cl-defgeneric emacsql-reconnect (connection)
"Re-establish CONNECTION with the same parameters.")
(cl-defmethod emacsql-live-p ((connection emacsql-connection))
"Return non-nil if CONNECTION is still alive and ready."
(and (process-live-p (oref connection handle)) t))
(cl-defgeneric emacsql-types (connection)
"Return an alist mapping EmacSQL types to database types.
This will mask `emacsql-type-map' during expression compilation.
This alist should have four key symbols: integer, float, object,
nil (default type). The values are strings to be inserted into
a SQL expression.")
(cl-defmethod emacsql-buffer ((connection emacsql-connection))
"Get process buffer for CONNECTION."
(process-buffer (oref connection handle)))
(cl-defmethod emacsql-enable-debugging ((connection emacsql-connection))
"Enable debugging on CONNECTION."
(unless (buffer-live-p (oref connection log-buffer))
(oset connection log-buffer (generate-new-buffer " *emacsql-log*"))))
(cl-defmethod emacsql-log ((connection emacsql-connection) message)
"Log MESSAGE into CONNECTION's log.
MESSAGE should not have a newline on the end."
(let ((buffer (oref connection log-buffer)))
(when buffer
(unless (buffer-live-p buffer)
(setq buffer (emacsql-enable-debugging connection)))
(with-current-buffer buffer
(goto-char (point-max))
(princ (concat message "\n") buffer)))))
;;; Sending and receiving
(cl-defgeneric emacsql-send-message (connection message)
"Send MESSAGE to CONNECTION.")
(cl-defmethod emacsql-send-message :before
((connection emacsql-connection) message)
(emacsql-log connection message))
(cl-defmethod emacsql-clear ((connection emacsql-connection))
"Clear the connection buffer for CONNECTION-SPEC."
(let ((buffer (emacsql-buffer connection)))
(when (and buffer (buffer-live-p buffer))
(with-current-buffer buffer
(erase-buffer)))))
(cl-defgeneric emacsql-waiting-p (connection)
"Return non-nil if CONNECTION is ready for more input.")
(cl-defmethod emacsql-wait ((connection emacsql-connection) &optional timeout)
"Block until CONNECTION is waiting for further input."
(let* ((real-timeout (or timeout emacsql-global-timeout))
(end (and real-timeout (+ (float-time) real-timeout))))
(while (and (or (null real-timeout) (< (float-time) end))
(not (emacsql-waiting-p connection)))
(save-match-data
(accept-process-output (oref connection handle) real-timeout)))
(unless (emacsql-waiting-p connection)
(signal 'emacsql-timeout (list "Query timed out" real-timeout)))))
(cl-defgeneric emacsql-parse (connection)
"Return the results of parsing the latest output or signal an error.")
(defun emacsql-compile (connection sql &rest args)
"Compile s-expression SQL for CONNECTION into a string."
(let ((emacsql-type-map (or (and connection (emacsql-types connection))
emacsql-type-map)))
(concat (apply #'emacsql-format (emacsql-prepare sql) args) ";")))
(cl-defgeneric emacsql (connection sql &rest args)
"Send SQL s-expression to CONNECTION and return the results.")
(cl-defmethod emacsql ((connection emacsql-connection) sql &rest args)
(let ((sql-string (apply #'emacsql-compile connection sql args)))
(emacsql-clear connection)
(emacsql-send-message connection sql-string)
(emacsql-wait connection)
(emacsql-parse connection)))
;;; Helper mixin class
(defclass emacsql-protocol-mixin () ()
"A mixin for back-ends following the EmacSQL protocol.
The back-end prompt must be a single \"]\" character. This prompt
value was chosen because it is unreadable. Output must have
exactly one row per line, fields separated by whitespace. NULL
must display as \"nil\"."
:abstract t)
(cl-defmethod emacsql-waiting-p ((connection emacsql-protocol-mixin))
"Return t if the end of the buffer has a properly-formatted prompt.
Also return t if the connection buffer has been killed."
(let ((buffer (emacsql-buffer connection)))
(or (not (buffer-live-p buffer))
(with-current-buffer buffer
(and (>= (buffer-size) 2)
(string= "#\n"
(buffer-substring (- (point-max) 2) (point-max))))))))
(cl-defmethod emacsql-handle ((_ emacsql-protocol-mixin) code message)
"Signal a specific condition for CODE from CONNECTION.
Subclasses should override this method in order to provide more
specific error conditions."
(signal 'emacsql-error (list message code)))
(cl-defmethod emacsql-parse ((connection emacsql-protocol-mixin))
"Parse well-formed output into an s-expression."
(with-current-buffer (emacsql-buffer connection)
(goto-char (point-min))
(let* ((standard-input (current-buffer))
(value (read)))
(if (eq value 'error)
(emacsql-handle connection (read) (read))
(prog1 value
(unless (eq (read) 'success)
(emacsql-handle connection (read) (read))))))))
;;; Automatic connection cleanup
(defun emacsql-register (connection)
"Register CONNECTION for automatic cleanup and return CONNECTION."
(prog1 connection
(oset connection finalizer
(make-finalizer (lambda () (emacsql-close connection))))))
;;; Useful macros
(defmacro emacsql-with-connection (connection-spec &rest body)
"Open an EmacSQL connection, evaluate BODY, and close the connection.
CONNECTION-SPEC establishes a single binding.
(emacsql-with-connection (db (emacsql-sqlite \"company.db\"))
(emacsql db [:create-table foo [x]])
(emacsql db [:insert :into foo :values ([1] [2] [3])])
(emacsql db [:select * :from foo]))"
(declare (indent 1))
`(let ((,(car connection-spec) ,(cadr connection-spec)))
(unwind-protect
(progn ,@body)
(emacsql-close ,(car connection-spec)))))
(defvar emacsql--transaction-level 0
"Keeps track of nested transactions in `emacsql-with-transaction'.")
(defmacro emacsql-with-transaction (connection &rest body)
"Evaluate BODY inside a single transaction, issuing a rollback on error.
This macro can be nested indefinitely, wrapping everything in a
single transaction at the lowest level.
Warning: BODY should *not* have any side effects besides making
changes to the database behind CONNECTION. Body may be evaluated
multiple times before the changes are committed."
(declare (indent 1))
`(let ((emacsql--connection ,connection)
(emacsql--completed nil)
(emacsql--transaction-level (1+ emacsql--transaction-level))
(emacsql--result))
(unwind-protect
(while (not emacsql--completed)
(condition-case nil
(progn
(when (= 1 emacsql--transaction-level)
(emacsql emacsql--connection [:begin]))
(let ((result (progn ,@body)))
(setq emacsql--result result)
(when (= 1 emacsql--transaction-level)
(emacsql emacsql--connection [:commit]))
(setq emacsql--completed t)))
(emacsql-locked (emacsql emacsql--connection [:rollback])
(sleep-for 0.05))))
(when (and (= 1 emacsql--transaction-level)
(not emacsql--completed))
(emacsql emacsql--connection [:rollback])))
emacsql--result))
(defmacro emacsql-thread (connection &rest statements)
"Thread CONNECTION through STATEMENTS.
A statement can be a list, containing a statement with its arguments."
(declare (indent 1))
`(let ((emacsql--conn ,connection))
(emacsql-with-transaction emacsql--conn
,@(cl-loop for statement in statements
when (vectorp statement)
collect (list 'emacsql 'emacsql--conn statement)
else
collect (append (list 'emacsql 'emacsql--conn) statement)))))
(defmacro emacsql-with-bind (connection sql-and-args &rest body)
"For each result row bind the column names for each returned row.
Returns the result of the last evaluated BODY.
All column names must be provided in the query ($ and * are not
allowed). Hint: all of the bound identifiers must be known at
compile time. For example, in the expression below the variables
`name' and `phone' will be bound for the body.
(emacsql-with-bind db [:select [name phone] :from people]
(message \"Found %s with %s\" name phone))
(emacsql-with-bind db ([:select [name phone]
:from people
:where (= name $1)] my-name)
(message \"Found %s with %s\" name phone))
Each column must be a plain symbol, no expressions allowed here."
(declare (indent 2))
(let ((sql (if (vectorp sql-and-args) sql-and-args (car sql-and-args)))
(args (and (not (vectorp sql-and-args)) (cdr sql-and-args))))
(cl-assert (eq :select (elt sql 0)))
(let ((vars (elt sql 1)))
(when (eq vars '*)
(error "Must explicitly list columns in `emacsql-with-bind'"))
(cl-assert (cl-every #'symbolp vars))
`(let ((emacsql--results (emacsql ,connection ,sql ,@args))
(emacsql--final nil))
(dolist (emacsql--result emacsql--results emacsql--final)
(setq emacsql--final
(cl-destructuring-bind ,(cl-coerce vars 'list) emacsql--result
,@body)))))))
;;; User interaction functions
(defvar emacsql-show-buffer-name "*emacsql-show*"
"Name of the buffer for displaying intermediate SQL.")
(defun emacsql--indent ()
"Indent and wrap the SQL expression in the current buffer."
(save-excursion
(goto-char (point-min))
(let ((case-fold-search nil))
(while (search-forward-regexp " [A-Z]+" nil :no-error)
(when (> (current-column) (* fill-column 0.8))
(backward-word)
(insert "\n "))))))
(defun emacsql-show-sql (string)
"Fontify and display the SQL expression in STRING."
(let ((fontified
(with-temp-buffer
(insert string)
(sql-mode)
(with-no-warnings ;; autoloaded by previous line
(sql-highlight-sqlite-keywords))
(font-lock-ensure)
(emacsql--indent)
(buffer-string))))
(with-current-buffer (get-buffer-create emacsql-show-buffer-name)
(if (< (length string) fill-column)
(message "%s" fontified)
(let ((buffer-read-only nil))
(erase-buffer)
(insert fontified))
(special-mode)
(visual-line-mode)
(pop-to-buffer (current-buffer))))))
(defun emacsql-flatten-sql (sql)
"Convert a s-expression SQL into a flat string for display."
(cl-destructuring-bind (string . vars) (emacsql-prepare sql)
(concat
(apply #'format string (cl-loop for i in (mapcar #'car vars)
collect (intern (format "$%d" (1+ i)))))
";")))
;;;###autoload
(defun emacsql-show-last-sql (&optional prefix)
"Display the compiled SQL of the s-expression SQL expression before point.
A prefix argument causes the SQL to be printed into the current buffer."
(interactive "P")
(let ((sexp (if (fboundp 'elisp--preceding-sexp)
(elisp--preceding-sexp)
(with-no-warnings
(preceding-sexp)))))
(if (emacsql-sql-p sexp)
(let ((sql (emacsql-flatten-sql sexp)))
(if prefix
(insert sql)
(emacsql-show-sql sql)))
(user-error "Invalid SQL: %S" sexp))))
;;; Fix Emacs' broken vector indentation
(defun emacsql--inside-vector-p ()
"Return non-nil if point is inside a vector expression."
(let ((start (point)))
(save-excursion
(beginning-of-defun)
(let ((containing-sexp (elt (parse-partial-sexp (point) start) 1)))
(and containing-sexp
(progn (goto-char containing-sexp)
(looking-at "\\[")))))))
(defun emacsql--calculate-vector-indent (fn &optional parse-start)
"Don't indent vectors in `emacs-lisp-mode' like lists."
(if (save-excursion (beginning-of-line) (emacsql--inside-vector-p))
(let ((lisp-indent-offset 1))
(funcall fn parse-start))
(funcall fn parse-start)))
(defun emacsql-fix-vector-indentation ()
"When called, advise `calculate-lisp-indent' to stop indenting vectors.
Once activated, vector contents no longer indent like lists."
(interactive)
(advice-add 'calculate-lisp-indent :around
#'emacsql--calculate-vector-indent))
(provide 'emacsql)
;;; emacsql.el ends here
================================================
FILE: test/.nosearch
================================================
================================================
FILE: test/Makefile
================================================
-include ../config.mk
include ../default.mk
LOAD_PATH += -L ../
TEST_ELS = emacsql-compiler-tests.el
TEST_ELS += emacsql-external-tests.el
TEST_ELCS = $(TEST_ELS:.el=.elc)
test: lisp
@printf "Running compiler tests...\n"
@$(EMACS_BATCH) -l emacsql-compiler-tests.elc -f ert-run-tests-batch-and-exit
@printf "Running connector tests...\n"
@$(EMACS_BATCH) -l emacsql-external-tests.elc -f ert-run-tests-batch-and-exit
test-interactive:
@$(EMACS_INTR) $(addprefix -l ,$(TEST_ELS)) --eval "(ert t)"
lisp: $(addprefix ../,$(ELCS)) $(TEST_ELCS)
%.elc: %.el
@printf "Compiling $<\n"
@$(EMACS_BATCH) --funcall batch-byte-compile $<
clean:
@printf " Cleaning test/*...\n"
@rm -rf $(TEST_ELCS)
================================================
FILE: test/emacsql-compiler-tests.el
================================================
;;; emacsql-tests.el --- Tests for emacsql -*- lexical-binding:t -*-
;; This is free and unencumbered software released into the public domain.
;;; Code:
(require 'ert)
(require 'emacsql)
(ert-deftest emacsql-escape-identifier ()
(should-error (emacsql-escape-identifier "foo"))
(should (string= (emacsql-escape-identifier 'foo) "foo"))
(should (string= (emacsql-escape-identifier 'a\ b) "\"a\\ b\""))
(should (string= (emacsql-escape-identifier '$foo) "\"$foo\""))
(emacsql-register-reserved '(SELECT))
(should (string= (emacsql-escape-identifier 'select) "\"select\""))
(should-error (emacsql-escape-identifier 10))
(should-error (emacsql-escape-identifier nil))
(should (string= (emacsql-escape-identifier 'person-id) "person_id"))
(should (string= (emacsql-escape-identifier 'people:person-id)
"people.person_id"))
(should (string= (emacsql-escape-identifier 'foo$) "foo$"))
(should (string= (emacsql-escape-identifier 'foo:bar) "foo.bar")))
(ert-deftest emacsql-escape-scalar ()
(should (string= (emacsql-escape-scalar 'foo) "'foo'"))
(should (string= (emacsql-escape-scalar "foo") "'\"foo\"'"))
(should (string= (emacsql-escape-scalar :foo) "':foo'"))
(should (string= (emacsql-escape-scalar [1 2 3]) "'[1 2 3]'"))
(should (string= (emacsql-escape-scalar '(a b c)) "'(a b c)'"))
(should (string= (emacsql-escape-scalar nil) "NULL")))
(ert-deftest emacsql-escape-vector ()
(should (string= (emacsql-escape-vector [1 2 3]) "(1, 2, 3)"))
(should (string= (emacsql-escape-vector '([1 2 3])) "(1, 2, 3)"))
(should (string= (emacsql-escape-vector '([1 2 3] [4 5 6]))
"(1, 2, 3), (4, 5, 6)")))
(ert-deftest emacsql-escape-raw ()
(should (string= (emacsql-escape-raw "/var/emacsql") "'/var/emacsql'"))
(should (string= (emacsql-escape-raw "a b c") "'a b c'"))
(should (string= (emacsql-escape-raw "a 'b' c") "'a ''b'' c'"))
(should (string= (emacsql-escape-raw nil) "NULL")))
(ert-deftest emacsql-schema ()
(should (string= (emacsql-prepare-schema [a]) "a &NONE"))
(should (string= (emacsql-prepare-schema [a b c])
"a &NONE, b &NONE, c &NONE"))
(should (string= (emacsql-prepare-schema [a (b)])
"a &NONE, b &NONE"))
(should (string= (emacsql-prepare-schema [a (b float)])
"a &NONE, b &REAL"))
(should (string= (emacsql-prepare-schema
[a (b float :primary-key :unique)])
"a &NONE, b &REAL PRIMARY KEY UNIQUE"))
(should (string= (emacsql-prepare-schema [(a integer) (b float)])
"a &INTEGER, b &REAL")))
(ert-deftest emacsql-param ()
(should (equal (emacsql-param 'a) nil))
(should (equal (emacsql-param 0) nil))
(should (equal (emacsql-param "") nil))
(should (equal (emacsql-param '$) nil))
(should (equal (emacsql-param '$1) nil))
(should (equal (emacsql-param '$s5) '(4 . :scalar)))
(should (equal (emacsql-param '$v10) '(9 . :vector)))
(should (equal (emacsql-param '$r2) '(1 . :raw)))
(should (equal (emacsql-param '$a) nil))
(should (equal (emacsql-param '$i10) '(9 . :identifier))))
(defun emacsql-tests-query (query args result)
"Check that QUERY outputs RESULT for ARGS."
(should (string= (apply #'emacsql-compile nil query args)
result)))
(defmacro emacsql-tests-with-queries (&rest queries)
"Thread `emacsql-tests-query' through QUERIES."
(declare (indent 0))
(cons 'progn (mapcar (lambda (q) (cons 'emacsql-tests-query q)) queries)))
(ert-deftest emacsql-select ()
(emacsql-tests-with-queries
([:select [$i1 name] :from $i2] '(id people)
"SELECT id, name FROM people;")
([:select * :from employees] '()
"SELECT * FROM employees;")
([:select * :from employees :where (< salary 50000)] '()
"SELECT * FROM employees WHERE salary < 50000;")
([:select * :from people :where (in name $v1)] '([FOO BAR])
"SELECT * FROM people WHERE name IN ('FOO', 'BAR');")
;; Sub queries
([:select name :from [:select * :from $i1]] '(people)
"SELECT name FROM (SELECT * FROM people);")
([:select name :from [people (as accounts a)]] '()
"SELECT name FROM people, accounts AS a;")
([:select p:name :from [(as [:select * :from people] p)]] '()
"SELECT p.name FROM (SELECT * FROM people) AS p;")))
(ert-deftest emacsql-attach ()
(emacsql-tests-with-queries
([:attach $r1 :as $i2] '("/var/foo.db" foo)
"ATTACH '/var/foo.db' AS foo;")
([:detach $i1] '(foo)
"DETACH foo;")))
(ert-deftest emacsql-create-table ()
(emacsql-tests-with-queries
([:create-table foo ([a b c])] ()
"CREATE TABLE foo (a &NONE, b &NONE, c &NONE);")
([:create-temporary-table :if-not-exists x ([y])] '()
"CREATE TEMPORARY TABLE IF NOT EXISTS x (y &NONE);")
([:create-table foo ([(a :default 10)])] '()
"CREATE TABLE foo (a &NONE DEFAULT 10);")
([:create-table foo ([(a :primary-key :not-null) b])] '()
"CREATE TABLE foo (a &NONE PRIMARY KEY NOT NULL, b &NONE);")
([:create-table foo ([a (b :check (< b 10))])] '()
"CREATE TABLE foo (a &NONE, b &NONE CHECK (b < 10));")
([:create-table foo $S1] '([a b (c :primary-key)])
"CREATE TABLE foo (a &NONE, b &NONE, c &NONE PRIMARY KEY);")
([:create-table foo ([a b (c :default "FOO")])] '()
"CREATE TABLE foo (a &NONE, b &NONE, c &NONE DEFAULT '\"FOO\"');")
;; From select
([:create-table $i1 :as [:select name :from $i2]] '(names people)
"CREATE TABLE names AS (SELECT name FROM people);")
;; Table constraints
([:create-table foo ([a b c] (:primary-key [a c]))] '()
"CREATE TABLE foo (a &NONE, b &NONE, c &NONE, PRIMARY KEY (a, c));")
([:create-table foo ([a b c] (:unique [a b c]))] '()
"CREATE TABLE foo (a &NONE, b &NONE, c &NONE, UNIQUE (a, b, c));")
([:create-table foo ([a b] (:check (< a b)))] '()
"CREATE TABLE foo (a &NONE, b &NONE, CHECK (a < b));")
([:create-table foo ([a b c]
( :foreign-key [a b]
:references bar [aa bb]
:on-delete :cascade))]
'()
(concat "CREATE TABLE foo (a &NONE, b &NONE, c &NONE, FOREIGN KEY (a, b) "
"REFERENCES bar (aa, bb) ON DELETE CASCADE);"))
;; Template
([:create-table $i1 $S2] '(foo [alpha beta delta])
"CREATE TABLE foo (alpha &NONE, beta &NONE, delta &NONE);")
;; Drop table
([:drop-table $i1] '(foo)
"DROP TABLE foo;")))
(ert-deftest emacsql-update ()
(emacsql-tests-with-queries
([:update people :set (= id $s1)] '(10)
"UPDATE people SET id = 10;")))
(ert-deftest emacsql-insert ()
(emacsql-tests-with-queries
([:insert :into foo :values [nil $s1]] '(10.1)
"INSERT INTO foo VALUES (NULL, 10.1);")
([:insert :into foo [a b] :values $v1] '([1 2])
"INSERT INTO foo (a, b) VALUES (1, 2);")
([:replace :into $i1 :values $v2] '(bar ([1 2] [3 4]))
"REPLACE INTO bar VALUES (1, 2), (3, 4);")))
(ert-deftest emacsql-order-by ()
(emacsql-tests-with-queries
([:order-by foo] '()
"ORDER BY foo;")
([:order-by [$i1]] '(bar)
"ORDER BY bar;")
([:order-by (- foo)] '()
"ORDER BY -foo;")
([:order-by [(asc a) (desc (/ b 2))]] '()
"ORDER BY a ASC, b / 2 DESC;")))
(ert-deftest emacsql-limit ()
(emacsql-tests-with-queries
([:limit 10] '()
"LIMIT 10;")
([:limit $s1] '(11)
"LIMIT 11;")
([:limit [12]] '()
"LIMIT 12;")
([:limit [2 10]] '()
"LIMIT 2, 10;")
([:limit [$s1 $s2]] '(4 30)
"LIMIT 4, 30;")))
(ert-deftest emacsql-quoting ()
(emacsql-tests-with-queries
([:where (= name 'foo)] '()
"WHERE name = 'foo';")
([:where (= name '$s1)] '(qux)
"WHERE name = 'qux';")
([:where (like url (escape "%`%%" ?`))] '()
"WHERE url LIKE '\"%`%%\"' ESCAPE '`';")))
(ert-deftest emacsql-expr ()
(emacsql-tests-with-queries
([:where (and a b)] '()
"WHERE a AND b;")
([:where (or a $i1)] '(b)
"WHERE a OR b;")
([:where (and $i1 $i2 $i3)] '(a b c)
"WHERE a AND b AND c;")
([:where (is foo (not nil))] '()
"WHERE foo IS (NOT NULL);")
([:where (is-not foo nil)] '()
"WHERE foo IS NOT NULL;")
([:where (= attrib :name)] '()
"WHERE attrib = ':name';")))
(ert-deftest emacsql-transaction ()
(emacsql-tests-with-queries
([:begin :transaction] '()
"BEGIN TRANSACTION;")
([:begin :immediate] '()
"BEGIN IMMEDIATE;")
([:rollback] '()
"ROLLBACK;")
([:commit] '()
"COMMIT;")))
(ert-deftest emacsql-alter-table ()
(emacsql-tests-with-queries
([:alter-table foo :rename-to bar] '()
"ALTER TABLE foo RENAME TO bar;")
([:alter-table $i1 :rename-to $i2] '(alpha beta)
"ALTER TABLE alpha RENAME TO beta;")
([:alter-table foo :add-column size :integer :not-null] '()
"ALTER TABLE foo ADD COLUMN size INTEGER NOT NULL;")))
(ert-deftest emacsql-funcall ()
(emacsql-tests-with-queries
([:select (funcall count x)] '()
"SELECT count(x);")
([:select (funcall count *)] '()
"SELECT count(*);")
([:select (funcall group-concat x y)] '()
"SELECT group_concat(x, y);")
([:select (funcall foobar :distinct x y)] '()
"SELECT foobar(':distinct', x, y);")
([:select (funcall count :distinct x)] '()
"SELECT count(DISTINCT x);")))
(ert-deftest emacsql-precedence ()
(emacsql-tests-with-queries
([:select (<< (not (is x nil)) 4)] '()
"SELECT (NOT x IS NULL) << 4;")
([:select (* 3 (+ (/ 14 2) (- 5 3)))] '()
"SELECT 3 * (14 / 2 + (5 - 3));")
([:select (- (|| (~ x) y))] '()
"SELECT -~x || y;")
([:select (funcall length (|| (* x x) (* y y) (* z z)))] '()
"SELECT length((x * x) || (y * y) || (z * z));")
([:select (and (+ (<= x y) 1) (>= y x))] '()
"SELECT (x <= y) + 1 AND y >= x;")
([:select (or (& (<= x (+ y 1) (- z)) 1) (>= x z y))] '()
"SELECT (y + 1 BETWEEN x AND -z) & 1 OR z BETWEEN y AND x;")))
;;; emacsql-tests.el ends here
================================================
FILE: test/emacsql-external-tests.el
================================================
;;; emacsql-external-tests.el --- Subprocess tests -*- lexical-binding:t -*-
;; This is free and unencumbered software released into the public domain.
;;; Code:
(require 'cl-lib)
(require 'ert)
(require 'emacsql)
(defvar emacsql-tests-timeout 4
"Be aggressive about not waiting on subprocesses in unit tests.")
(defvar emacsql-tests-connection-factories nil
"List of connection factories to use in unit tests.")
(defun emacsql-tests-add-connection-factory
(connector &optional dep min pred envvars)
(declare (indent defun))
(cond
((and min (version< emacs-version min))
(message " ! skip `%s'; requires Emacs >= %s" connector min))
((and dep (not (with-demoted-errors "%S" (require dep nil t))))
(message " ! skip `%s'; library `%s' not available" connector dep))
((and pred (not (funcall pred)))
(message " ! skip `%s'; sanity check failed" connector))
((not (with-demoted-errors "%S" (require connector nil t)))
(message " ! skip `%s'; failed to load library" connector))
((let* ((unset ())
(args (if envvars
(mapcan (lambda (var)
(let* ((envvar (car var))
(keyword (cadr var))
(value (and envvar (getenv envvar))))
(cond ((not value) (push envvar unset) nil)
(keyword (list keyword value))
((list value)))))
envvars)
(list nil))))
(if unset
(message " ! skip `%s'; required envvars not set" connector)
(message " test `%s' connector" connector)
(push (apply #'apply-partially connector args)
emacsql-tests-connection-factories))))))
(cl-eval-when (load eval)
(emacsql-tests-add-connection-factory 'emacsql-sqlite-builtin 'sqlite "29.1"
'sqlite-available-p)
(emacsql-tests-add-connection-factory 'emacsql-sqlite-module 'sqlite3 nil
(lambda () (boundp 'module-file-suffix)))
(emacsql-tests-add-connection-factory 'emacsql-mysql nil nil nil
'(("MYSQL_DATABASE")
("MYSQL_USER" :user)
("MYSQL_PASSWORD" :password)
("MYSQL_HOST" :host)
("MYSQL_PORT" :port)))
(emacsql-tests-add-connection-factory 'emacsql-psql nil nil nil
'(("PSQL_DATABASE")
("PSQL_USER" :username)
("PSQL_HOST" :hostname)
("PSQL_PORT" :port)))
(message " ! skip `emacsql-pg' connector; known to be broken")
;; FIXME Fix broken `emacsql-pg'.
;; (emacsql-tests-add-connection-factory 'emacsql-pg 'pg "28.1" nil
;; '(("PG_DATABASE")
;; ("PG_USER")
;; ("PG_PASSWORD" :password)
;; ("PG_HOST" :host)
;; ("PG_PORT" :port)))
)
(ert-deftest emacsql-basic ()
"A short test that fully interacts with SQLite."
(let ((emacsql-global-timeout emacsql-tests-timeout))
(dolist (factory emacsql-tests-connection-factories)
(emacsql-with-connection (db (funcall factory))
(emacsql db [:create-temporary-table foo ([x])])
(should-error (emacsql db [:create-temporary-table foo ([x])]))
(emacsql db [:insert :into foo :values ([1] [2] [3])])
(should (equal (emacsql db [:select * :from foo])
'((1) (2) (3))))))))
(ert-deftest emacsql-nul-character ()
"Try inserting and retrieving strings with a NUL byte."
(let ((emacsql-global-timeout emacsql-tests-timeout))
(dolist (factory emacsql-tests-connection-factories)
(emacsql-with-connection (db (funcall factory))
(emacsql db [:create-temporary-table foo ([x])])
(emacsql db [:insert :into foo :values (["a\0bc"])])
(should (equal (emacsql db [:select * :from foo])
'(("a\0bc"))))))))
(ert-deftest emacsql-foreign-key ()
"Tests that foreign keys work properly through EmacSQL."
(let ((emacsql-global-timeout emacsql-tests-timeout))
(dolist (factory emacsql-tests-connection-factories)
(emacsql-with-connection (db (funcall factory))
(unwind-protect
(progn
(emacsql-thread db
[:create-table person ([(id integer :primary-key) name])]
[:create-table likes
([(personid integer) color]
(:foreign-key [personid] :references person [id]
:on-delete :cascade))]
[:insert :into person :values ([0 "Chris"] [1 "Brian"])])
(should (equal (emacsql db [:select * :from person :order-by id])
'((0 "Chris") (1 "Brian"))))
(emacsql db [:insert :into likes
:values ([0 red] [0 yellow] [1 yellow])])
(should (equal (emacsql db [:select * :from likes
:order-by [personid color]])
'((0 red) (0 yellow) (1 yellow))))
(emacsql db [:delete :from person :where (= id 0)])
(should (equal (emacsql db [:select * :from likes])
'((1 yellow)))))
(emacsql-thread db
[:drop-table likes]
[:drop-table person]))))))
(ert-deftest emacsql-error ()
"Check that we're getting expected conditions."
(should-error (emacsql-compile nil [:insert :into foo :values 1])
:type 'emacsql-syntax)
(let ((emacsql-global-timeout emacsql-tests-timeout))
(dolist (factory emacsql-tests-connection-factories)
(emacsql-with-connection (db (funcall factory))
(emacsql db [:create-temporary-table foo ([x])])
(should-error (emacsql db [:create-temporary-table foo ([x])])
:type 'emacsql-error)))))
(ert-deftest emacsql-special-chars ()
"A short test that interacts with SQLite with special characters."
(let ((emacsql-global-timeout 4))
(dolist (factory emacsql-tests-connection-factories)
(emacsql-with-connection (db (funcall factory))
(emacsql db [:create-temporary-table test-table ([x])])
(emacsql db [:insert-into test-table :values ([" "] [\])])
(when (cl-typep db 'process)
(should (emacsql-live-p db)))
(should (equal (emacsql db [:select * :from test-table])
'((" ") (\))))))))
;;; emacsql-external-tests.el ends here
gitextract_pqc2acux/
├── .dir-locals.el
├── .elpaignore
├── .github/
│ └── workflows/
│ ├── compile.yml
│ ├── stats.yml
│ └── test.yml
├── .gitignore
├── Makefile
├── README.md
├── UNLICENSE
├── default.mk
├── docs/
│ └── Makefile
├── emacsql-compiler.el
├── emacsql-mysql.el
├── emacsql-pg.el
├── emacsql-psql.el
├── emacsql-sqlite-builtin.el
├── emacsql-sqlite-module.el
├── emacsql-sqlite.el
├── emacsql.el
└── test/
├── .nosearch
├── Makefile
├── emacsql-compiler-tests.el
└── emacsql-external-tests.el
Condensed preview — 23 files, each showing path, character count, and a content snippet. Download the .json file or copy for the full structured content (118K chars).
[
{
"path": ".dir-locals.el",
"chars": 151,
"preview": "((nil\n (indent-tabs-mode . nil))\n (makefile-mode\n (indent-tabs-mode . t))\n (git-commit-mode\n (git-commit-major-mode ."
},
{
"path": ".elpaignore",
"chars": 71,
"preview": ".dir-locals.el\n.elpaignore\n.github\n.gitignore\nMakefile\ntests\nUNLICENSE\n"
},
{
"path": ".github/workflows/compile.yml",
"chars": 214,
"preview": "name: Compile\non: [push, pull_request]\njobs:\n compile:\n name: Compile\n uses: | # zizmor: ignore[unpinned-uses] sa"
},
{
"path": ".github/workflows/stats.yml",
"chars": 322,
"preview": "name: Statistics\non:\n push:\n branches: main\n schedule:\n - cron: '3 13 * * 1'\njobs:\n stats:\n name: Statistics"
},
{
"path": ".github/workflows/test.yml",
"chars": 3666,
"preview": "name: Test\npermissions: read-all\non: [ push, pull_request ]\nenv:\n pwd: ${{ github.event.repository.name }}\njobs:\n matr"
},
{
"path": ".gitignore",
"chars": 47,
"preview": "/*.elc\n/*-autoloads.el\n/config.mk\n/docs/stats/\n"
},
{
"path": "Makefile",
"chars": 1702,
"preview": "-include config.mk\ninclude default.mk\n\n.PHONY: test\n\nall: lisp\n\nhelp:\n\t$(info make all -- Generate lisp and"
},
{
"path": "README.md",
"chars": 14512,
"preview": "# EmacSQL\n\nEmacSQL is a high-level Emacs Lisp front-end for SQLite.\n\nPostgreSQL and MySQL are also supported, but use of"
},
{
"path": "UNLICENSE",
"chars": 1211,
"preview": "This is free and unencumbered software released into the public domain.\n\nAnyone is free to copy, modify, publish, use, c"
},
{
"path": "default.mk",
"chars": 1041,
"preview": "TOP := $(dir $(lastword $(MAKEFILE_LIST)))\n\nDOMAIN ?= magit.vc\n\nPKG = emacsql\n\nELS = $(PKG)-compiler.el\nELS += $(PKG)"
},
{
"path": "docs/Makefile",
"chars": 429,
"preview": "-include ../config.mk\ninclude ../default.mk\n\n.PHONY: stats\n\nSTAT_DOMAIN = stats.$(DOMAIN)\nSTAT_TARGET = $(subst .,_,$(ST"
},
{
"path": "emacsql-compiler.el",
"chars": 22220,
"preview": ";;; emacsql-compiler.el --- S-expression SQL compiler -*- lexical-binding:t -*-\n\n;; This is free and unencumbered softw"
},
{
"path": "emacsql-mysql.el",
"chars": 6270,
"preview": ";;; emacsql-mysql.el --- EmacSQL back-end for MySQL -*- lexical-binding:t -*-\n\n;; This is free and unencumbered softwar"
},
{
"path": "emacsql-pg.el",
"chars": 3132,
"preview": ";;; emacsql-pg.el --- EmacSQL back-end for PostgreSQL via pg -*- lexical-binding:t -*-\n\n;; This is free and unencumbere"
},
{
"path": "emacsql-psql.el",
"chars": 5869,
"preview": ";;; emacsql-psql.el --- EmacSQL back-end for PostgreSQL via psql -*- lexical-binding:t -*-\n\n;; This is free and unencum"
},
{
"path": "emacsql-sqlite-builtin.el",
"chars": 3353,
"preview": ";;; emacsql-sqlite-builtin.el --- EmacSQL back-end for SQLite using builtin support -*- lexical-binding:t -*-\n\n;; This "
},
{
"path": "emacsql-sqlite-module.el",
"chars": 3733,
"preview": ";;; emacsql-sqlite-module.el --- EmacSQL back-end for SQLite using a module -*- lexical-binding:t -*-\n\n;; This is free "
},
{
"path": "emacsql-sqlite.el",
"chars": 13177,
"preview": ";;; emacsql-sqlite.el --- Code used by both SQLite back-ends -*- lexical-binding:t -*-\n\n;; This is free and unencumbere"
},
{
"path": "emacsql.el",
"chars": 14832,
"preview": ";;; emacsql.el --- High-level SQL database front-end -*- lexical-binding:t -*-\n\n;; This is free and unencumbered softwa"
},
{
"path": "test/.nosearch",
"chars": 0,
"preview": ""
},
{
"path": "test/Makefile",
"chars": 701,
"preview": "-include ../config.mk\ninclude ../default.mk\n\nLOAD_PATH += -L ../\n\nTEST_ELS = emacsql-compiler-tests.el\nTEST_ELS += emac"
},
{
"path": "test/emacsql-compiler-tests.el",
"chars": 10013,
"preview": ";;; emacsql-tests.el --- Tests for emacsql -*- lexical-binding:t -*-\n\n;; This is free and unencumbered software release"
},
{
"path": "test/emacsql-external-tests.el",
"chars": 6381,
"preview": ";;; emacsql-external-tests.el --- Subprocess tests -*- lexical-binding:t -*-\n\n;; This is free and unencumbered software"
}
]
About this extraction
This page contains the full source code of the magit/emacsql GitHub repository, extracted and formatted as plain text for AI agents and large language models (LLMs). The extraction includes 23 files (110.4 KB), approximately 29.7k tokens. Use this with OpenClaw, Claude, ChatGPT, Cursor, Windsurf, or any other AI tool that accepts text input. You can copy the full output to your clipboard or download it as a .txt file.
Extracted by GitExtract — free GitHub repo to text converter for AI. Built by Nikandr Surkov.