├── .dir-locals.el ├── .github └── workflows │ ├── compile.yml │ ├── stats.yml │ └── test.yml ├── .gitignore ├── Makefile ├── README.md ├── UNLICENSE ├── 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 └── tests ├── .nosearch ├── emacsql-compiler-tests.el └── emacsql-external-tests.el /.dir-locals.el: -------------------------------------------------------------------------------- 1 | ((nil 2 | (indent-tabs-mode . nil)) 3 | (makefile-mode 4 | (indent-tabs-mode . t)) 5 | (git-commit-mode 6 | (git-commit-major-mode . git-commit-elisp-text-mode))) 7 | -------------------------------------------------------------------------------- /.github/workflows/compile.yml: -------------------------------------------------------------------------------- 1 | name: Compile 2 | on: [push, pull_request] 3 | jobs: 4 | compile: 5 | name: Compile 6 | uses: emacscollective/workflows/.github/workflows/compile.yml@main 7 | -------------------------------------------------------------------------------- /.github/workflows/stats.yml: -------------------------------------------------------------------------------- 1 | name: Statistics 2 | on: 3 | push: 4 | branches: main 5 | schedule: 6 | - cron: '3 13 * * 1' 7 | jobs: 8 | stats: 9 | name: Statistics 10 | uses: emacscollective/workflows/.github/workflows/stats.yml@main 11 | secrets: 12 | aws-access-key-id: ${{ secrets.AWS_ACCESS_KEY_ID }} 13 | aws-secret-access-key: ${{ secrets.AWS_SECRET_ACCESS_KEY }} 14 | -------------------------------------------------------------------------------- /.github/workflows/test.yml: -------------------------------------------------------------------------------- 1 | name: Test 2 | permissions: read-all 3 | on: [ push, pull_request ] 4 | env: 5 | pwd: ${{ github.event.repository.name }} 6 | jobs: 7 | matrix: 8 | name: 'Get matrix' 9 | runs-on: ubuntu-24.04 10 | outputs: 11 | matrix: ${{ steps.matrix.outputs.matrix }} 12 | steps: 13 | - name: 'Install Emacs' 14 | uses: purcell/setup-emacs@master 15 | with: 16 | version: 30.1 17 | - name: 'Install scripts' 18 | uses: actions/checkout@v4 19 | with: 20 | repository: emacscollective/workflows 21 | ref: ${{ inputs.workflow_ref }} 22 | path: _scripts 23 | persist-credentials: false 24 | - name: 'Checkout ${{ github.repository }}' 25 | uses: actions/checkout@v4 26 | with: 27 | path: ${{ env.pwd }} 28 | persist-credentials: false 29 | - name: 'Get matrix' 30 | id: matrix 31 | working-directory: ${{ env.pwd }} 32 | run: | 33 | ../_scripts/bin/get-matrix >> $GITHUB_OUTPUT 34 | echo "• get-matrix: emacscollective/workflows@${{ inputs.workflow_ref }}" 35 | main: 36 | name: 'Test using Emacs ${{ matrix.emacs }}' 37 | runs-on: ubuntu-24.04 38 | needs: matrix 39 | strategy: 40 | fail-fast: false 41 | matrix: 42 | emacs: ${{ fromJson(needs.matrix.outputs.matrix) }} 43 | services: 44 | postgres: 45 | image: postgres:14 46 | env: 47 | POSTGRES_PASSWORD: postgres 48 | POSTGRES_HOST_AUTH_METHOD: trust 49 | options: >- 50 | --health-cmd pg_isready 51 | --health-interval 10s 52 | --health-timeout 5s 53 | --health-retries 5 54 | ports: 55 | - 5432:5432 56 | mysql: 57 | image: mysql:8.0 58 | env: 59 | MYSQL_ROOT_PASSWORD: emacsql 60 | MYSQL_DATABASE: emacsql 61 | MYSQL_USER: emacsql 62 | MYSQL_PASSWORD: emacsql 63 | ports: 64 | - 3306:3306 65 | options: >- 66 | --health-cmd="mysqladmin ping" 67 | --health-interval=10s 68 | --health-timeout=5s 69 | --health-retries=3 70 | steps: 71 | - name: 'Install Emacs' 72 | uses: purcell/setup-emacs@master 73 | with: 74 | version: ${{ matrix.emacs }} 75 | - name: 'Checkout scripts' 76 | uses: actions/checkout@v4 77 | with: 78 | repository: emacscollective/workflows 79 | ref: ${{ inputs.workflow_ref }} 80 | path: _scripts 81 | persist-credentials: false 82 | - name: 'Checkout ${{ github.repository }}' 83 | uses: actions/checkout@v4 84 | with: 85 | path: ${{ env.pwd }} 86 | persist-credentials: false 87 | - name: 'Install dependencies' 88 | working-directory: ${{ env.pwd }} 89 | run: ../_scripts/bin/install-deps 90 | - name: 'Build Sqlite3' 91 | working-directory: sqlite3 92 | run: nix-shell -p sqlite.dev --run "make all" 93 | - name: 'Build Emacsql' 94 | run: nix-shell -p sqlite.dev --run "make all" 95 | working-directory: ${{ env.pwd }} 96 | - name: 'Test Emacsql' 97 | run: make test 98 | working-directory: ${{ env.pwd }} 99 | env: 100 | MYSQL_DATABASE: emacsql 101 | MYSQL_USER: emacsql 102 | MYSQL_PASSWORD: emacsql 103 | MYSQL_HOST: 127.0.0.1 104 | MYSQL_PORT: 3306 105 | PSQL_DATABASE: postgres 106 | PSQL_USER: postgres 107 | PSQL_HOST: 127.0.0.1 108 | PSQL_PORT: 5432 109 | PG_DATABASE: postgres 110 | PG_USER: postgres 111 | PG_PASSWORD: postgres 112 | PG_HOST: 127.0.0.1 113 | PG_PORT: 5432 114 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | /*.elc 2 | /*-autoloads.el 3 | /.config.mk 4 | /stats/ 5 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | -include .config.mk 2 | 3 | PKG = emacsql 4 | 5 | ELS = $(PKG)-compiler.el 6 | ELS += $(PKG).el 7 | ELS += $(PKG)-sqlite.el 8 | ELS += $(PKG)-sqlite-builtin.el 9 | ELS += $(PKG)-sqlite-module.el 10 | ELS += $(PKG)-mysql.el 11 | ELS += $(PKG)-psql.el 12 | ELS += $(PKG)-pg.el 13 | ELCS = $(ELS:.el=.elc) 14 | 15 | TEST_ELS = tests/emacsql-compiler-tests.el 16 | TEST_ELS += tests/emacsql-external-tests.el 17 | TEST_ELCS = $(TEST_ELS:.el=.elc) 18 | 19 | DEPS = pg 20 | DEPS += peg 21 | DEPS += sqlite3 22 | 23 | EMACS ?= emacs 24 | 25 | ifeq ($(CI), true) 26 | # Workaround for bug#58252 on Emacs 28.x. 27 | override EMACS_ARGS += --eval "(setq byte-compile-docstring-max-column 120)" 28 | else 29 | EMACS_ARGS ?= 30 | endif 31 | 32 | ifdef NIX_PATH 33 | export SQLITE3_API_BUILD_COMMAND = nix-shell -p sqlite.dev --run "make all" 34 | endif 35 | 36 | LOAD_PATH ?= $(addprefix -L ../,$(DEPS)) 37 | LOAD_PATH += -L . 38 | LOAD_PATH += -L ./tests 39 | 40 | all: lisp 41 | 42 | help: 43 | $(info make all - generate byte-code and autoloads) 44 | $(info make lisp - generate byte-code and autoloads) 45 | $(info make redo - re-generate byte-code and autoloads) 46 | $(info make test - run tests) 47 | $(info make clean - remove byte-code and autoloads) 48 | @printf "\n" 49 | 50 | redo: clean lisp 51 | lisp: $(ELCS) loaddefs 52 | 53 | loaddefs: $(PKG)-autoloads.el 54 | 55 | %.elc: %.el 56 | @printf "Compiling $<\n" 57 | @$(EMACS) -Q --batch $(EMACS_ARGS) $(LOAD_PATH) -f batch-byte-compile $< 58 | 59 | check-declare: 60 | @printf " Checking function declarations\n" 61 | @$(EMACS) -Q --batch $(EMACS_ARGS) $(LOAD_PATH) \ 62 | --eval "(check-declare-directory default-directory)" 63 | 64 | CLEAN = $(ELCS) $(TEST_ELCS) $(PKG)-autoloads.el 65 | 66 | clean: 67 | @printf " Cleaning...\n" 68 | @rm -rf $(CLEAN) 69 | 70 | $(PKG)-autoloads.el: $(ELS) 71 | @printf " Creating $@\n" 72 | @$(EMACS) -Q --batch -l autoload -l cl-lib --eval "\ 73 | (let ((file (expand-file-name \"$@\"))\ 74 | (autoload-timestamps nil) \ 75 | (backup-inhibited t)\ 76 | (version-control 'never)\ 77 | (coding-system-for-write 'utf-8-emacs-unix))\ 78 | (write-region (autoload-rubric file \"package\" nil) nil file nil 'silent)\ 79 | (cl-letf (((symbol-function 'progress-reporter-do-update) (lambda (&rest _)))\ 80 | ((symbol-function 'progress-reporter-done) (lambda (_))))\ 81 | (let ((generated-autoload-file file))\ 82 | (update-directory-autoloads default-directory))))" \ 83 | 2>&1 | sed "/^Package autoload is deprecated$$/d" 84 | 85 | test: all $(TEST_ELCS) 86 | @printf "Running compiler tests...\n" 87 | @$(EMACS) -Q --batch $(EMACS_ARGS) $(LOAD_PATH) -L tests \ 88 | -l tests/emacsql-compiler-tests.elc -f ert-run-tests-batch-and-exit 89 | @printf "Running connector tests...\n" 90 | @$(EMACS) -Q --batch $(EMACS_ARGS) $(LOAD_PATH) -L tests \ 91 | -l tests/emacsql-external-tests.elc -f ert-run-tests-batch-and-exit 92 | 93 | ifeq ($(CI), true) 94 | override GITSTATS = ../_gitstats/gitstats 95 | endif 96 | GITSTATS ?= gitstats 97 | GITSTATS_DIR ?= stats 98 | GITSTATS_ARGS ?= -c style=https://magit.vc/assets/stats.css -c max_authors=999 99 | 100 | DOMAIN ?= magit.vc 101 | CFRONT_DIST ?= E2LUHBKU1FBV02 102 | S3_BUCKET ?= s3://$(DOMAIN) 103 | 104 | .PHONY: stats 105 | stats: 106 | @printf "Generating statistics\n" 107 | @$(GITSTATS) $(GITSTATS_ARGS) . $(GITSTATS_DIR) 108 | 109 | stats-upload: 110 | @printf "Uploading statistics...\n" 111 | @aws s3 sync $(GITSTATS_DIR) $(S3_BUCKET)/stats/$(PKG) 112 | @printf "Uploaded to $(S3_BUCKET)/stats/$(PKG)\n" 113 | @printf "Generating CDN invalidation\n" 114 | @aws cloudfront create-invalidation \ 115 | --distribution-id $(CFRONT_DIST) --paths "/stats/*" > /dev/null 116 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # EmacSQL 2 | 3 | EmacSQL is a high-level Emacs Lisp front-end for SQLite. 4 | 5 | PostgreSQL and MySQL are also supported, but use of these connectors 6 | is not recommended. 7 | 8 | Any [readable lisp value][readable] can be stored as a value in 9 | EmacSQL, including numbers, strings, symbols, lists, vectors, and 10 | closures. EmacSQL has no concept of "TEXT" values; it's all just lisp 11 | objects. The lisp object `nil` corresponds 1:1 with `NULL` in the 12 | database. 13 | 14 | Requires Emacs 26 or later. 15 | 16 | [![Compile](https://github.com/magit/emacsql/actions/workflows/compile.yml/badge.svg)](https://github.com/magit/emacsql/actions/workflows/compile.yml) 17 | [![Test](https://github.com/magit/emacsql/actions/workflows/test.yml/badge.svg)](https://github.com/magit/emacsql/actions/workflows/test.yml) 18 | [![NonGNU ELPA](https://emacsair.me/assets/badges/nongnu-elpa.svg)](https://elpa.nongnu.org/nongnu-devel/emacsql.html) 19 | [![MELPA Stable](https://stable.melpa.org/packages/emacsql-badge.svg)](https://stable.melpa.org/#/emacsql) 20 | [![MELPA](https://melpa.org/packages/emacsql-badge.svg)](https://melpa.org/#/emacsql) 21 | 22 | ### FAQ 23 | #### Why are all values stored as strings? 24 | 25 | EmacSQL is not intended to interact with arbitrary databases, but to 26 | be an ACID-compliant database for Emacs extensions. This means that 27 | EmacSQL cannot be used with a regular SQL database used by other 28 | non-Emacs clients. 29 | 30 | All database values must be s-expressions. When EmacSQL stores a 31 | value — string, symbol, cons, etc. — it is printed and written to 32 | the database in its printed form. Strings are wrapped in quotes 33 | and escaped as necessary. That means "bare" symbols in the database 34 | generally look like strings. The only exception is `nil`, which is 35 | stored as `NULL`. 36 | 37 | #### Will EmacSQL ever support arbitrary databases? 38 | 39 | The author of EmacSQL [thinks][mistake] that it was probably a 40 | design mistake to restrict it to Emacs by storing only printed values, 41 | and that it would be a lot more useful if it just handled primitive 42 | database types. 43 | 44 | However, EmacSQL is in maintenance mode and there are no plans to 45 | make any fundamental changes, not least because they would break all 46 | existing packages and databases that rely on the current EmacSQL 47 | behavior. 48 | 49 | ### Windows Issues 50 | 51 | Emacs `start-process-shell-command` function is not supported on 52 | Windows. Since both `emacsql-mysql` and `emacsql-psql` rely on this 53 | function, neither of these connection types are supported on Windows. 54 | 55 | ## Example Usage 56 | 57 | ```el 58 | (defvar db (emacsql-sqlite-open "~/company.db")) 59 | 60 | ;; Create a table. Table and column identifiers are symbols. 61 | (emacsql db [:create-table people ([name id salary])]) 62 | 63 | ;; Or optionally provide column constraints. 64 | (emacsql db [:create-table people 65 | ([name (id integer :primary-key) (salary float)])]) 66 | 67 | ;; Insert some data: 68 | (emacsql db [:insert :into people 69 | :values (["Jeff" 1000 60000.0] ["Susan" 1001 64000.0])]) 70 | 71 | ;; Query the database for results: 72 | (emacsql db [:select [name id] 73 | :from people 74 | :where (> salary 62000)]) 75 | ;; => (("Susan" 1001)) 76 | 77 | ;; Queries can be templates, using $1, $2, etc.: 78 | (emacsql db [:select [name id] 79 | :from people 80 | :where (> salary $s1)] 81 | 50000) 82 | ;; => (("Jeff" 1000) ("Susan" 1001)) 83 | ``` 84 | 85 | When editing these prepared SQL s-expression statements, the `M-x 86 | emacsql-show-last-sql` command (think `eval-last-sexp`) is useful for 87 | seeing what the actual SQL expression will become when compiled. 88 | 89 | ## Schema 90 | 91 | A table schema is a list whose first element is a vector of column 92 | specifications. The rest of the list specifies table constraints. A 93 | column identifier is a symbol and a column's specification can either 94 | be just this symbol or it can include constraints as a list. Because 95 | EmacSQL stores entire lisp objects as values, the only relevant (and 96 | allowed) types are `integer`, `float`, and `object` (default). 97 | 98 | ([() ...] ( ...) ...]) 99 | 100 | Dashes in identifiers are converted into underscores when compiled 101 | into SQL. This allows for lisp-style identifiers to be used in SQL. 102 | Constraints follow the compilation rules below. 103 | 104 | ```el 105 | ;; No constraints schema with four columns: 106 | ([name id building room]) 107 | 108 | ;; Add some column constraints: 109 | ([(name :unique) (id integer :primary-key) building room]) 110 | 111 | ;; Add some table constraints: 112 | ([(name :unique) (id integer :primary-key) building room] 113 | (:unique [building room]) 114 | (:check (> id 0))) 115 | ``` 116 | 117 | Here's an example using foreign keys. 118 | 119 | ```el 120 | ;; "subjects" table schema 121 | ([(id integer :primary-key) subject]) 122 | 123 | ;; "tag" table references subjects 124 | ([(subject-id integer) tag] 125 | (:foreign-key [subject-id] :references subjects [id] 126 | :on-delete :cascade)) 127 | ``` 128 | 129 | Foreign key constraints are enabled by default in EmacSQL. 130 | 131 | ## Operators 132 | 133 | Expressions are written lisp-style, with the operator first. If it 134 | looks like an operator EmacSQL treats it like an operator. However, 135 | several operators are special. 136 | 137 | <= >= funcall quote 138 | 139 | The `<=` and `>=` operators accept 2 or 3 operands, transforming into 140 | a SQL `_ BETWEEN _ AND _` operator as appropriate. 141 | 142 | For function-like "operators" like `count` and `max` use the `funcall` 143 | "operator." 144 | 145 | ```el 146 | [:select (funcall max age) :from people] 147 | ``` 148 | 149 | With `glob` and `like` SQL operators keep in mind that they're 150 | matching the *printed* representations of these values, even if the 151 | value is a string. 152 | 153 | The `||` concatenation operator is unsupported because concatenating 154 | printed representations breaks an important constraint: all values must 155 | remain readable within SQLite. 156 | 157 | ## Quoting 158 | 159 | Inside expressions, EmacSQL cannot tell the difference between symbol 160 | literals and column references. If you're talking about the symbol 161 | itself, just quote it as you would in normal Elisp. Note that this 162 | does not "escape" `$tn` parameter symbols. 163 | 164 | ```el 165 | (emacsql db [... :where (= category 'hiking)]) 166 | ``` 167 | 168 | Quoting a string makes EmacSQL handle it as a "raw string." These raw 169 | strings are not printed when being assembled into a query. These are 170 | intended for use in special circumstances like filenames (`ATTACH`) or 171 | pattern matching (`LIKE`). It is vital that raw strings are not 172 | returned as results. 173 | 174 | ```el 175 | (emacsql db [... :where (like name '"%foo%")]) 176 | (emacsql db [:attach '"/path/to/foo.db" :as foo]) 177 | ``` 178 | 179 | Since template parameters include their type they never need to be 180 | quoted. 181 | 182 | ## Prepared Statements 183 | 184 | The database is interacted with via prepared SQL s-expression 185 | statements. You shouldn't normally be concatenating strings on your 186 | own. (And it leaves out any possibility of a SQL injection!) See the 187 | "Usage" section above for examples. A statement is a vector of 188 | keywords and other lisp object. 189 | 190 | Prepared EmacSQL s-expression statements are compiled into SQL 191 | statements. The statement compiler is memorized so that using the same 192 | statement multiple times is fast. To assist in this, the statement can 193 | act as a template -- using `$i1`, `$s2`, etc. -- working like the 194 | Elisp `format` function. 195 | 196 | ### Compilation Rules 197 | 198 | Rather than the typical uppercase SQL keywords, keywords in a prepared 199 | EmacSQL statement are literally just that: lisp keywords. EmacSQL only 200 | understands a very small amount of SQL's syntax. The compiler follows 201 | some simple rules to convert an s-expression into SQL. 202 | 203 | #### All prepared statements are vectors. 204 | 205 | A prepared s-expression statement is a vector beginning with a keyword 206 | followed by a series of keywords and special values. This includes 207 | most kinds of sub-queries. 208 | 209 | ```el 210 | [:select ... :from ...] 211 | [:select tag :from tags 212 | :where (in tag [:select ...])] 213 | ``` 214 | 215 | #### Keywords are split and capitalized. 216 | 217 | Dashes are converted into spaces and the keyword gets capitalized. For 218 | example, `:if-not-exists` becomes `IF NOT EXISTS`. How you choose to 219 | combine keywords is up to your personal taste (e.g., `:drop :table` vs. 220 | `:drop-table`). 221 | 222 | #### Standalone symbols are identifiers. 223 | 224 | EmacSQL doesn't know what symbols refer to identifiers and what 225 | symbols should be treated as values. Use quotes to mark a symbol as a 226 | value. For example, `people` here will be treated as an identifier. 227 | 228 | ```el 229 | [:insert-into people :values ...] 230 | ``` 231 | 232 | #### Row-oriented information is always represented as vectors. 233 | 234 | This includes rows being inserted, and sets of columns in a query. If 235 | you're talking about a row-like thing then put it in a vector. 236 | 237 | ```el 238 | [:select [id name] :from people] 239 | ``` 240 | 241 | Note that `*` is actually a SQL keyword, so don't put it in a vector. 242 | 243 | ```el 244 | [:select * :from ...] 245 | ``` 246 | 247 | #### Lists are treated as expressions. 248 | 249 | This is true even within row-oriented vectors. 250 | 251 | ```el 252 | [... :where (= name "Bob")] 253 | [:select [(/ seconds 60) count] :from ...] 254 | ``` 255 | 256 | Some things that are traditionally keywords -- particularly those that 257 | are mixed in with expressions -- have been converted into operators 258 | (`AS`, `ASC`, `DESC`). 259 | 260 | ```el 261 | [... :order-by [(asc b), (desc a)]] ; "ORDER BY b ASC, a DESC" 262 | [:select p:name :from (as people p)] ; "SELECT p.name FROM people AS p" 263 | ``` 264 | 265 | #### The `:values` keyword is special. 266 | 267 | What follows `:values` is always treated like a vector or list of 268 | vectors. Normally this sort of thing would appear to be a column 269 | reference. 270 | 271 | ```el 272 | [... :values [1 2 3]] 273 | [... :values ([1 2 3] [4 5 6])] ; insert multiple rows 274 | ``` 275 | 276 | #### A list whose first element is a vector is a table schema. 277 | 278 | This is to distinguish schemata from everything else. With the 279 | exception of what follows `:values`, nothing else is shaped like this. 280 | 281 | ```el 282 | [:create-table people ([(id :primary-key) name])] 283 | ``` 284 | 285 | ### Templates 286 | 287 | To make statement compilation faster, and to avoid making you build up 288 | statements dynamically, you can insert `$tn` parameters in place of 289 | identifiers and values. These refer to the argument's type and its 290 | argument position after the statement in the `emacsql` function, 291 | one-indexed. 292 | 293 | ```el 294 | (emacsql db [:select * :from $i1 :where (> salary $s2)] 'employees 50000) 295 | 296 | (emacsql db [:select * :from employees :where (like name $r1)] "%Smith%") 297 | ``` 298 | 299 | The letter before the number is the type. 300 | 301 | * `i` : identifier 302 | * `s` : scalar 303 | * `v` : vector (or multiple vectors) 304 | * `r` : raw, unprinted strings 305 | * `S` : schema 306 | 307 | When combined with `:values`, the vector type can refer to lists of 308 | rows. 309 | 310 | ```el 311 | (emacsql db [:insert-into favorite-characters :values $v1] 312 | '([0 "Calvin"] [1 "Hobbes"] [3 "Susie"])) 313 | ``` 314 | 315 | This is why rows must be vectors and not lists. 316 | 317 | ### Ignored Features 318 | 319 | EmacSQL doesn't cover all of SQLite's features. Here are a list of 320 | things that aren't supported, and probably will never be. 321 | 322 | * Collating. SQLite has three built-in collation functions: BINARY 323 | (default), NOCASE, and RTRIM. EmacSQL values never have right-hand 324 | whitespace, so RTRIM won't be of any use. NOCASE is broken 325 | (ASCII-only) and there's little reason to use it. 326 | 327 | * Text manipulation functions. Like collating this is incompatible 328 | with EmacSQL s-expression storage. 329 | 330 | * Date and time. These are incompatible with the printed values 331 | stored by EmacSQL and therefore have little use. 332 | 333 | ## Limitations 334 | 335 | EmacSQL is *not* intended to play well with other programs accessing 336 | the SQLite database. Non-numeric values are stored encoded as 337 | s-expressions TEXT values. This avoids ambiguities in parsing output 338 | from the command line and allows for storage of Emacs richer data 339 | types. This is an efficient, ACID-compliant database specifically for 340 | Emacs. 341 | 342 | ## Emacs Lisp Indentation Annoyance 343 | 344 | By default, `emacs-lisp-mode` indents vectors as if they were regular 345 | function calls. 346 | 347 | ```el 348 | ;; Ugly indentation! 349 | (emacsql db [:select * 350 | :from people 351 | :where (> age 60)]) 352 | ``` 353 | 354 | Calling the function `emacsql-fix-vector-indentation` (interactive) 355 | advises the major mode to fix this annoyance. 356 | 357 | ```el 358 | ;; Such indent! 359 | (emacsql db [:select * 360 | :from people 361 | :where (> age 60)]) 362 | ``` 363 | 364 | ## Contributing and Extending 365 | 366 | To run the test suite, clone the `pg` and `sqlite3` packages into 367 | sibling directories. The Makefile will automatically put these paths on 368 | the Emacs load path (override `LDFLAGS` if your situation is different). 369 | 370 | ```shell 371 | git clone https://github.com/emarsden/pg-el ../pg 372 | git clone https://github.com/pekingduck/emacs-sqlite3-api ../sqlite3 373 | ``` 374 | 375 | Or set `LOAD_PATH` to point at these packages elsewhere: 376 | 377 | ```shell 378 | make LOAD_PATH='-L path/to/pg -L path/to/sqlite3' 379 | ``` 380 | 381 | Then invoke make: 382 | 383 | ```shell 384 | make test 385 | ``` 386 | 387 | If the environment variable `PGDATABASE` is present then the unit 388 | tests will also be run with PostgreSQL (emacsql-psql). Provide 389 | `PGHOST`, `PGPORT`, and `PGUSER` if needed. If `PGUSER` is provided, 390 | the pg.el back-end (emacsql-pg) will also be tested. 391 | 392 | If the environment variable `MYSQL_DBNAME` is present then the unit 393 | tests will also be run with MySQL in the named database. Note that 394 | this is not an official MySQL variable, just something made up for 395 | EmacSQL. 396 | 397 | ### Creating a New Front-end 398 | 399 | EmacSQL uses EIEIO so that interactions with a connection occur 400 | through generic functions. You need to define a new class that 401 | inherits from `emacsql-connection`. 402 | 403 | * Implement `emacsql-send-message`, `emacsql-waiting-p`, 404 | `emacsql-parse`, and `emacsql-close`. 405 | * Provide a constructor that initializes the connection and calls 406 | `emacsql-register` (for automatic connection cleanup). 407 | * Provide `emacsql-types` if needed (hint: use a class-allocated slot). 408 | * Ensure that you properly read NULL as nil (hint: ask your back-end 409 | to print it that way). 410 | * Register all reserved words with `emacsql-register-reserved`. 411 | * Preferably provide `emacsql-reconnect` if possible. 412 | * Set the default isolation level to *serializable*. 413 | * Enable autocommit mode by default. 414 | * Prefer ANSI syntax (value escapes, identifier escapes, etc.). 415 | * Enable foreign key constraints by default. 416 | 417 | The goal of the autocommit, isolation, parsing, and foreign key 418 | configuration settings is to normalize the interface as much as 419 | possible. The connection's user should have the option to be agnostic 420 | about which back-end is actually in use. 421 | 422 | The provided implementations should serve as useful examples. If your 423 | back-end outputs data in a clean, standard way you may be able to use 424 | the emacsql-protocol-mixin class to do most of the work. 425 | 426 | ## See Also 427 | 428 | * [SQLite Documentation](https://www.sqlite.org/docs.html) 429 | 430 | [readable]: http://nullprogram.com/blog/2013/12/30/#almost_everything_prints_readably 431 | [mistake]: https://github.com/magit/emacsql/issues/35#issuecomment-346352439 432 | 433 | 434 | 435 | -------------------------------------------------------------------------------- /UNLICENSE: -------------------------------------------------------------------------------- 1 | This is free and unencumbered software released into the public domain. 2 | 3 | Anyone is free to copy, modify, publish, use, compile, sell, or 4 | distribute this software, either in source code form or as a compiled 5 | binary, for any purpose, commercial or non-commercial, and by any 6 | means. 7 | 8 | In jurisdictions that recognize copyright laws, the author or authors 9 | of this software dedicate any and all copyright interest in the 10 | software to the public domain. We make this dedication for the benefit 11 | of the public at large and to the detriment of our heirs and 12 | successors. We intend this dedication to be an overt act of 13 | relinquishment in perpetuity of all present and future rights to this 14 | software under copyright law. 15 | 16 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 17 | EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 18 | MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. 19 | IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR 20 | OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, 21 | ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR 22 | OTHER DEALINGS IN THE SOFTWARE. 23 | 24 | For more information, please refer to 25 | -------------------------------------------------------------------------------- /emacsql-compiler.el: -------------------------------------------------------------------------------- 1 | ;;; emacsql-compiler.el --- S-expression SQL compiler -*- lexical-binding:t -*- 2 | 3 | ;; This is free and unencumbered software released into the public domain. 4 | 5 | ;; Author: Christopher Wellons 6 | ;; Maintainer: Jonas Bernoulli 7 | 8 | ;; SPDX-License-Identifier: Unlicense 9 | 10 | ;;; Commentary: 11 | 12 | ;; This library provides support for compiling S-expressions to SQL. 13 | 14 | ;;; Code: 15 | 16 | (require 'cl-lib) 17 | 18 | (eval-when-compile (require 'subr-x)) 19 | 20 | ;;; Error symbols 21 | 22 | (defmacro emacsql-deferror (symbol parents message) 23 | "Defines a new error symbol for EmacSQL." 24 | (declare (indent 2)) 25 | (let ((conditions (cl-remove-duplicates 26 | (append parents (list symbol 'emacsql-error 'error))))) 27 | `(prog1 ',symbol 28 | (put ',symbol 'error-conditions ',conditions) 29 | (put ',symbol 'error-message ,message)))) 30 | 31 | (emacsql-deferror emacsql-error () ;; parent condition for all others 32 | "EmacSQL had an unhandled condition") 33 | 34 | (emacsql-deferror emacsql-syntax () "Invalid SQL statement") 35 | (emacsql-deferror emacsql-internal () "Internal error") 36 | (emacsql-deferror emacsql-locked () "Database locked") 37 | (emacsql-deferror emacsql-fatal () "Fatal error") 38 | (emacsql-deferror emacsql-memory () "Out of memory") 39 | (emacsql-deferror emacsql-corruption () "Database corrupted") 40 | (emacsql-deferror emacsql-access () "Database access error") 41 | (emacsql-deferror emacsql-timeout () "Query timeout error") 42 | (emacsql-deferror emacsql-warning () "Warning message") 43 | 44 | (defun emacsql-error (format &rest args) 45 | "Like `error', but signal an emacsql-syntax condition." 46 | (signal 'emacsql-syntax (list (apply #'format format args)))) 47 | 48 | ;;; Escaping functions 49 | 50 | (defvar emacsql-reserved (make-hash-table :test 'equal) 51 | "Collection of all known reserved words, used for escaping.") 52 | 53 | (defun emacsql-register-reserved (seq) 54 | "Register sequence of keywords as reserved words, returning SEQ." 55 | (cl-loop for word being the elements of seq 56 | do (setf (gethash (upcase (format "%s" word)) emacsql-reserved) t) 57 | finally (cl-return seq))) 58 | 59 | (defun emacsql-reserved-p (name) 60 | "Returns non-nil if string NAME is a SQL keyword." 61 | (gethash (upcase name) emacsql-reserved)) 62 | 63 | (defun emacsql-quote-scalar (string) 64 | "Single-quote (scalar) STRING for use in a SQL expression." 65 | (with-temp-buffer 66 | (insert string) 67 | (goto-char (point-min)) 68 | (while (re-search-forward "'" nil t) 69 | (replace-match "''")) 70 | (goto-char (point-min)) 71 | (insert "'") 72 | (goto-char (point-max)) 73 | (insert "'") 74 | (buffer-string))) 75 | 76 | (defun emacsql-quote-character (c) 77 | "Single-quote character C for use in a SQL expression." 78 | (if (char-equal c ?') 79 | "''''" 80 | (format "'%c'" c))) 81 | 82 | (defun emacsql-quote-identifier (string) 83 | "Double-quote (identifier) STRING for use in a SQL expression." 84 | (format "\"%s\"" (replace-regexp-in-string "\"" "\"\"" string))) 85 | 86 | (defun emacsql-escape-identifier (identifier) 87 | "Escape an identifier, if needed, for SQL." 88 | (when (or (null identifier) 89 | (keywordp identifier) 90 | (not (or (symbolp identifier) 91 | (vectorp identifier)))) 92 | (emacsql-error "Invalid identifier: %S" identifier)) 93 | (cond 94 | ((vectorp identifier) 95 | (mapconcat #'emacsql-escape-identifier identifier ", ")) 96 | ((eq identifier '*) "*") 97 | (t 98 | (let ((name (symbol-name identifier))) 99 | (if (string-match-p ":" name) 100 | (mapconcat #'emacsql-escape-identifier 101 | (mapcar #'intern (split-string name ":")) ".") 102 | (let ((print (replace-regexp-in-string "-" "_" (format "%S" identifier))) 103 | (special "[]-\000-\040!\"#%&'()*+,./:;<=>?@[\\^`{|}~\177]")) 104 | (if (or (string-match-p special print) 105 | (string-match-p "^[0-9$]" print) 106 | (emacsql-reserved-p print)) 107 | (emacsql-quote-identifier print) 108 | print))))))) 109 | 110 | (defvar print-escape-control-characters) 111 | 112 | (defun emacsql-escape-scalar (value) 113 | "Escape VALUE for sending to SQLite." 114 | (let ((print-escape-newlines t) 115 | (print-escape-control-characters t)) 116 | (cond ((null value) "NULL") 117 | ((numberp value) (prin1-to-string value)) 118 | ((emacsql-quote-scalar (prin1-to-string value)))))) 119 | 120 | (defun emacsql-escape-raw (value) 121 | "Escape VALUE for sending to SQLite." 122 | (cond ((null value) "NULL") 123 | ((stringp value) (emacsql-quote-scalar value)) 124 | ((error "Expected string or nil")))) 125 | 126 | (defun emacsql-escape-vector (vector) 127 | "Encode VECTOR into a SQL vector scalar." 128 | (cl-typecase vector 129 | (null (emacsql-error "Empty SQL vector expression")) 130 | (list (mapconcat #'emacsql-escape-vector vector ", ")) 131 | (vector (concat "(" (mapconcat #'emacsql-escape-scalar vector ", ") ")")) 132 | (otherwise (emacsql-error "Invalid vector %S" vector)))) 133 | 134 | (defun emacsql-escape-format (thing) 135 | "Escape THING for use as a `format' spec." 136 | (replace-regexp-in-string "%" "%%" thing)) 137 | 138 | ;;; Schema compiler 139 | 140 | (defvar emacsql-type-map 141 | '((integer "&INTEGER") 142 | (float "&REAL") 143 | (object "&TEXT") 144 | (nil "&NONE")) 145 | "An alist mapping EmacSQL types to SQL types.") 146 | 147 | (defun emacsql--from-keyword (keyword) 148 | "Convert KEYWORD into SQL." 149 | (let ((name (substring (symbol-name keyword) 1))) 150 | (upcase (replace-regexp-in-string "-" " " name)))) 151 | 152 | (defun emacsql--prepare-constraints (constraints) 153 | "Compile CONSTRAINTS into a partial SQL expression." 154 | (mapconcat 155 | #'identity 156 | (cl-loop for constraint in constraints collect 157 | (cl-typecase constraint 158 | (null "NULL") 159 | (keyword (emacsql--from-keyword constraint)) 160 | (symbol (emacsql-escape-identifier constraint)) 161 | (vector (format "(%s)" 162 | (mapconcat 163 | #'emacsql-escape-identifier 164 | constraint 165 | ", "))) 166 | (list (format "(%s)" 167 | (car (emacsql--*expr constraint)))) 168 | (otherwise 169 | (emacsql-escape-scalar constraint)))) 170 | " ")) 171 | 172 | (defun emacsql--prepare-column (column) 173 | "Convert COLUMN into a partial SQL string." 174 | (mapconcat 175 | #'identity 176 | (cl-etypecase column 177 | (symbol (list (emacsql-escape-identifier column) 178 | (cadr (assoc nil emacsql-type-map)))) 179 | (list (cl-destructuring-bind (name . constraints) column 180 | (cl-delete-if 181 | (lambda (s) (zerop (length s))) 182 | (list (emacsql-escape-identifier name) 183 | (if (member (car constraints) '(integer float object)) 184 | (cadr (assoc (pop constraints) emacsql-type-map)) 185 | (cadr (assoc nil emacsql-type-map))) 186 | (emacsql--prepare-constraints constraints)))))) 187 | " ")) 188 | 189 | (defun emacsql-prepare-schema (schema) 190 | "Compile SCHEMA into a SQL string." 191 | (if (vectorp schema) 192 | (emacsql-prepare-schema (list schema)) 193 | (cl-destructuring-bind (columns . constraints) schema 194 | (mapconcat 195 | #'identity 196 | (nconc 197 | (mapcar #'emacsql--prepare-column columns) 198 | (mapcar #'emacsql--prepare-constraints constraints)) 199 | ", ")))) 200 | 201 | ;;; Statement compilation 202 | 203 | (defvar emacsql-prepare-cache (make-hash-table :test 'equal :weakness 'key) 204 | "Cache used to memoize `emacsql-prepare'.") 205 | 206 | (defvar emacsql--vars () 207 | "Used within `emacsql-with-params' to collect parameters.") 208 | 209 | (defun emacsql-sql-p (thing) 210 | "Return non-nil if THING looks like a prepared statement." 211 | (and (vectorp thing) (> (length thing) 0) (keywordp (aref thing 0)))) 212 | 213 | (defun emacsql-param (thing) 214 | "Return the index and type of THING, or nil if THING is not a parameter. 215 | A parameter is a symbol that looks like $i1, $s2, $v3, etc. The 216 | letter refers to the type: identifier (i), scalar (s), 217 | vector (v), raw string (r), schema (S)." 218 | (and (symbolp thing) 219 | (let ((name (symbol-name thing))) 220 | (and (string-match-p "^\\$[isvrS][0-9]+$" name) 221 | (cons (1- (read (substring name 2))) 222 | (cl-ecase (aref name 1) 223 | (?i :identifier) 224 | (?s :scalar) 225 | (?v :vector) 226 | (?r :raw) 227 | (?S :schema))))))) 228 | 229 | (defmacro emacsql-with-params (prefix &rest body) 230 | "Evaluate BODY, collecting parameters. 231 | Provided local functions: `param', `identifier', `scalar', `raw', 232 | `svector', `expr', `subsql', and `combine'. BODY should return a 233 | string, which will be combined with variable definitions." 234 | (declare (indent 1)) 235 | `(let ((emacsql--vars ())) 236 | (cl-flet* ((combine (prepared) (emacsql--*combine prepared)) 237 | (param (thing) (emacsql--!param thing)) 238 | (identifier (thing) (emacsql--!param thing :identifier)) 239 | (scalar (thing) (emacsql--!param thing :scalar)) 240 | (raw (thing) (emacsql--!param thing :raw)) 241 | (svector (thing) (combine (emacsql--*vector thing))) 242 | (expr (thing) (combine (emacsql--*expr thing))) 243 | (subsql (thing) 244 | (format "(%s)" (combine (emacsql-prepare thing))))) 245 | (cons (concat ,prefix (progn ,@body)) emacsql--vars)))) 246 | 247 | (defun emacsql--!param (thing &optional kind) 248 | "Parse, escape, and store THING. 249 | If optional KIND is not specified, then try to guess it. 250 | Only use within `emacsql-with-params'!" 251 | (cl-flet ((check (param) 252 | (when (and kind (not (eq kind (cdr param)))) 253 | (emacsql-error 254 | "Invalid parameter type %s, expecting %s" thing kind)))) 255 | (let ((param (emacsql-param thing))) 256 | (if (null param) 257 | (emacsql-escape-format 258 | (if kind 259 | (cl-case kind 260 | (:identifier (emacsql-escape-identifier thing)) 261 | (:scalar (emacsql-escape-scalar thing)) 262 | (:vector (emacsql-escape-vector thing)) 263 | (:raw (emacsql-escape-raw thing)) 264 | (:schema (emacsql-prepare-schema thing))) 265 | (if (and (not (null thing)) 266 | (not (keywordp thing)) 267 | (symbolp thing)) 268 | (emacsql-escape-identifier thing) 269 | (emacsql-escape-scalar thing)))) 270 | (prog1 (if (eq (cdr param) :schema) "(%s)" "%s") 271 | (check param) 272 | (setq emacsql--vars (nconc emacsql--vars (list param)))))))) 273 | 274 | (defun emacsql--*vector (vector) 275 | "Prepare VECTOR." 276 | (emacsql-with-params "" 277 | (cl-typecase vector 278 | (symbol (emacsql--!param vector :vector)) 279 | (list (mapconcat #'svector vector ", ")) 280 | (vector (format "(%s)" (mapconcat #'scalar vector ", "))) 281 | (otherwise (emacsql-error "Invalid vector: %S" vector))))) 282 | 283 | (defmacro emacsql--generate-op-lookup-defun (name operator-precedence-groups) 284 | "Generate function to look up predefined SQL operator metadata. 285 | 286 | The generated function is bound to NAME and accepts two 287 | arguments, OPERATOR-NAME and OPERATOR-ARGUMENT-COUNT. 288 | OPERATOR-PRECEDENCE-GROUPS should be a number of lists containing 289 | operators grouped by operator precedence (in order of precedence 290 | from highest to lowest). A single operator is represented by a 291 | list of at least two elements: operator name (symbol) and 292 | operator arity (:unary or :binary). Optionally a custom 293 | expression can be included, which defines how the operator is 294 | expanded into an SQL expression (there are two defaults, one for 295 | :unary and one for :binary operators). 296 | 297 | An example for OPERATOR-PRECEDENCE-GROUPS: 298 | \(((+ :unary (\"+\" :operand)) (- :unary (\"-\" :operand))) 299 | ((+ :binary) (- :binary)))" 300 | `(defun ,name (operator-name operator-argument-count) 301 | "Look up predefined SQL operator metadata. 302 | See `emacsql--generate-op-lookup-defun' for details." 303 | (cond 304 | ,@(cl-loop 305 | for precedence-value from 1 306 | for precedence-group in (reverse operator-precedence-groups) 307 | append (cl-loop 308 | for (op-name arity custom-expr) in precedence-group 309 | for sql-name = (upcase (symbol-name op-name)) 310 | for sql-expr = 311 | (or custom-expr 312 | (pcase arity 313 | (:unary `(,sql-name " " :operand)) 314 | (:binary `(:operand " " ,sql-name " " :operand)))) 315 | 316 | collect (list `(and (eq operator-name 317 | (quote ,op-name)) 318 | ,(if (eq arity :unary) 319 | `(eql operator-argument-count 1) 320 | `(>= operator-argument-count 2))) 321 | `(list ',sql-expr ,arity ,precedence-value)))) 322 | (t (list nil nil nil))))) 323 | 324 | (emacsql--generate-op-lookup-defun 325 | emacsql--get-op 326 | (((~ :unary ("~" :operand))) 327 | ((collate :binary)) 328 | ((|| :binary)) 329 | ((* :binary) (/ :binary) (% :binary)) 330 | ((+ :unary ("+" :operand)) (- :unary ("-" :operand))) 331 | ((+ :binary) (- :binary)) 332 | ((& :binary) (| :binary) (<< :binary) (>> :binary)) 333 | ((escape :binary (:operand " ESCAPE " :operand))) 334 | ((< :binary) (<= :binary) (> :binary) (>= :binary)) 335 | 336 | (;;TODO? (between :binary) (not-between :binary) 337 | (is :binary) (is-not :binary (:operand " IS NOT " :operand)) 338 | (match :binary) (not-match :binary (:operand " NOT MATCH " :operand)) 339 | (like :binary) (not-like :binary (:operand " NOT LIKE " :operand)) 340 | (in :binary) (not-in :binary (:operand " NOT IN " :operand)) 341 | (isnull :unary (:operand " ISNULL")) 342 | (notnull :unary (:operand " NOTNULL")) 343 | (= :binary) (== :binary) 344 | (!= :binary) (<> :binary) 345 | (glob :binary) (not-glob :binary (:operand " NOT GLOB " :operand)) 346 | (regexp :binary) (not-regexp :binary (:operand " NOT REGEXP " :operand))) 347 | 348 | ((not :unary)) 349 | ((and :binary)) 350 | ((or :binary)))) 351 | 352 | (defun emacsql--expand-format-string (op expr arity argument-count) 353 | "Create format-string for an SQL operator. 354 | The format-string returned is intended to be used with `format' 355 | to create an SQL expression." 356 | (and expr 357 | (cl-labels ((replace-operand (x) (if (eq x :operand) "%s" x)) 358 | (to-format-string (e) (mapconcat #'replace-operand e ""))) 359 | (cond 360 | ((and (eq arity :unary) (eql argument-count 1)) 361 | (to-format-string expr)) 362 | ((and (eq arity :binary) (>= argument-count 2)) 363 | (let ((result (reverse expr))) 364 | (dotimes (_ (- argument-count 2)) 365 | (setq result (nconc (reverse expr) (cdr result)))) 366 | (to-format-string (nreverse result)))) 367 | (t (emacsql-error "Wrong number of operands for %s" op)))))) 368 | 369 | (defun emacsql--get-op-info (op argument-count parent-precedence-value) 370 | "Lookup SQL operator information for generating an SQL expression. 371 | Returns the following multiple values when an operator can be 372 | identified: a format string (see `emacsql--expand-format-string') 373 | and a precedence value. If PARENT-PRECEDENCE-VALUE is greater or 374 | equal to the identified operator's precedence, then the format 375 | string returned is wrapped with parentheses." 376 | (cl-destructuring-bind (format-string arity precedence-value) 377 | (emacsql--get-op op argument-count) 378 | (let ((expanded-format-string 379 | (emacsql--expand-format-string 380 | op 381 | format-string 382 | arity 383 | argument-count))) 384 | (cl-values (cond 385 | ((null format-string) nil) 386 | ((>= parent-precedence-value 387 | precedence-value) 388 | (format "(%s)" expanded-format-string)) 389 | (t expanded-format-string)) 390 | precedence-value)))) 391 | 392 | (defun emacsql--*expr (expr &optional parent-precedence-value) 393 | "Expand EXPR recursively." 394 | (emacsql-with-params "" 395 | (cond 396 | ((emacsql-sql-p expr) (subsql expr)) 397 | ((vectorp expr) (svector expr)) 398 | ((atom expr) (param expr)) 399 | ((cl-destructuring-bind (op . args) expr 400 | (cl-multiple-value-bind (format-string precedence-value) 401 | (emacsql--get-op-info op 402 | (length args) 403 | (or parent-precedence-value 0)) 404 | (cl-flet ((recur (n) 405 | (combine (emacsql--*expr (nth n args) 406 | (or precedence-value 0)))) 407 | (nops (op) 408 | (emacsql-error "Wrong number of operands for %s" op))) 409 | (cl-case op 410 | ;; Special cases <= >= 411 | ((<= >=) 412 | (cl-case (length args) 413 | (2 (format format-string (recur 0) (recur 1))) 414 | (3 (format (if (>= (or parent-precedence-value 0) 415 | precedence-value) 416 | "(%s BETWEEN %s AND %s)" 417 | "%s BETWEEN %s AND %s") 418 | (recur 1) 419 | (recur (if (eq op '>=) 2 0)) 420 | (recur (if (eq op '>=) 0 2)))) 421 | (otherwise (nops op)))) 422 | ;; enforce second argument to be a character 423 | ((escape) 424 | (let ((second-arg (cadr args))) 425 | (cond 426 | ((not (= 2 (length args))) (nops op)) 427 | ((not (characterp second-arg)) 428 | (emacsql-error 429 | "Second operand of escape has to be a character, got %s" 430 | second-arg)) 431 | (t (format format-string 432 | (recur 0) 433 | (emacsql-quote-character second-arg)))))) 434 | ;; Ordering 435 | ((asc desc) 436 | (format "%s %s" (recur 0) (upcase (symbol-name op)))) 437 | ;; Special case quote 438 | ((quote) (let ((arg (nth 0 args))) 439 | (if (stringp arg) 440 | (raw arg) 441 | (scalar arg)))) 442 | ;; Special case funcall 443 | ((funcall) 444 | (format "%s(%s)" (recur 0) 445 | (cond 446 | ((and (= 2 (length args)) 447 | (eq '* (nth 1 args))) 448 | "*") 449 | ((and (= 3 (length args)) 450 | (eq :distinct (nth 1 args)) 451 | (format "DISTINCT %s" (recur 2)))) 452 | ((mapconcat 453 | #'recur (cl-loop for i from 1 below (length args) 454 | collect i) 455 | ", "))))) 456 | ;; Guess 457 | (otherwise 458 | (let ((arg-indices (cl-loop for i from 0 below (length args) collect i))) 459 | (if format-string 460 | (apply #'format format-string (mapcar #'recur arg-indices)) 461 | (mapconcat 462 | #'recur (cl-loop for i from 0 below (length args) collect i) 463 | (format " %s " (upcase (symbol-name op))))))))))))))) 464 | 465 | (defun emacsql--*idents (idents) 466 | "Read in a vector of IDENTS identifiers, or just an single identifier." 467 | (emacsql-with-params "" 468 | (mapconcat #'expr idents ", "))) 469 | 470 | (defun emacsql--*combine (prepared) 471 | "Append parameters from PREPARED to `emacsql--vars', return the string. 472 | Only use within `emacsql-with-params'!" 473 | (cl-destructuring-bind (string . vars) prepared 474 | (setq emacsql--vars (nconc emacsql--vars vars)) 475 | string)) 476 | 477 | (defun emacsql-prepare--string (string) 478 | "Create a prepared statement from STRING." 479 | (emacsql-with-params "" 480 | (replace-regexp-in-string 481 | "\\$[isv][0-9]+" (lambda (v) (param (intern v))) string))) 482 | 483 | (defun emacsql-prepare--sexp (sexp) 484 | "Create a prepared statement from SEXP." 485 | (emacsql-with-params "" 486 | (cl-loop with items = (cl-coerce sexp 'list) 487 | and last = nil 488 | while (not (null items)) 489 | for item = (pop items) 490 | collect 491 | (cl-typecase item 492 | (keyword (if (eq :values item) 493 | (concat "VALUES " (svector (pop items))) 494 | (emacsql--from-keyword item))) 495 | (symbol (if (eq item '*) 496 | "*" 497 | (param item))) 498 | (vector (if (emacsql-sql-p item) 499 | (subsql item) 500 | (let ((idents (combine 501 | (emacsql--*idents item)))) 502 | (if (keywordp last) 503 | idents 504 | (format "(%s)" idents))))) 505 | (list (if (vectorp (car item)) 506 | (emacsql-escape-format 507 | (format "(%s)" 508 | (emacsql-prepare-schema item))) 509 | (combine (emacsql--*expr item)))) 510 | (otherwise 511 | (emacsql-escape-format 512 | (emacsql-escape-scalar item)))) 513 | into parts 514 | do (setq last item) 515 | finally (cl-return (string-join parts " "))))) 516 | 517 | (defun emacsql-prepare (sql) 518 | "Expand SQL (string or sexp) into a prepared statement." 519 | (let* ((cache emacsql-prepare-cache) 520 | (key (cons emacsql-type-map sql))) 521 | (or (gethash key cache) 522 | (setf (gethash key cache) 523 | (if (stringp sql) 524 | (emacsql-prepare--string sql) 525 | (emacsql-prepare--sexp sql)))))) 526 | 527 | (defun emacsql-format (expansion &rest args) 528 | "Fill in the variables EXPANSION with ARGS." 529 | (cl-destructuring-bind (format . vars) expansion 530 | (let ((print-level nil) 531 | (print-length nil)) 532 | (apply #'format format 533 | (cl-loop for (i . kind) in vars collect 534 | (let ((thing (nth i args))) 535 | (cl-case kind 536 | (:identifier (emacsql-escape-identifier thing)) 537 | (:scalar (emacsql-escape-scalar thing)) 538 | (:vector (emacsql-escape-vector thing)) 539 | (:raw (emacsql-escape-raw thing)) 540 | (:schema (emacsql-prepare-schema thing)) 541 | (otherwise 542 | (emacsql-error "Invalid var type %S" kind))))))))) 543 | 544 | (provide 'emacsql-compiler) 545 | 546 | ;;; emacsql-compiler.el ends here 547 | -------------------------------------------------------------------------------- /emacsql-mysql.el: -------------------------------------------------------------------------------- 1 | ;;; emacsql-mysql.el --- EmacSQL back-end for MySQL -*- lexical-binding:t -*- 2 | 3 | ;; This is free and unencumbered software released into the public domain. 4 | 5 | ;; Author: Christopher Wellons 6 | ;; Maintainer: Jonas Bernoulli 7 | 8 | ;; SPDX-License-Identifier: Unlicense 9 | 10 | ;;; Commentary: 11 | 12 | ;; This library provides an EmacSQL back-end for MySQL, which uses 13 | ;; the standard `msql' command line program. 14 | 15 | ;;; Code: 16 | 17 | (require 'emacsql) 18 | 19 | (defvar emacsql-mysql-executable "mysql" 20 | "Path to the mysql command line executable.") 21 | 22 | (defvar emacsql-mysql-sentinel "--------------\n\n--------------\n\n" 23 | "What MySQL will print when it has completed its output.") 24 | 25 | (defconst emacsql-mysql-reserved 26 | (emacsql-register-reserved 27 | '( ACCESSIBLE ADD ALL ALTER ANALYZE AND AS ASC ASENSITIVE BEFORE 28 | BETWEEN BIGINT BINARY BLOB BOTH BY CALL CASCADE CASE CHANGE CHAR 29 | CHARACTER CHECK COLLATE COLUMN CONDITION CONSTRAINT CONTINUE 30 | CONVERT CREATE CROSS CURRENT_DATE CURRENT_TIME CURRENT_TIMESTAMP 31 | CURRENT_USER CURSOR DATABASE DATABASES DAY_HOUR DAY_MICROSECOND 32 | DAY_MINUTE DAY_SECOND DEC DECIMAL DECLARE DEFAULT DELAYED DELETE 33 | DESC DESCRIBE DETERMINISTIC DISTINCT DISTINCTROW DIV DOUBLE DROP 34 | DUAL EACH ELSE ELSEIF ENCLOSED ESCAPED EXISTS EXIT EXPLAIN FALSE 35 | FETCH FLOAT FLOAT4 FLOAT8 FOR FORCE FOREIGN FROM FULLTEXT GENERAL 36 | GRANT GROUP HAVING HIGH_PRIORITY HOUR_MICROSECOND HOUR_MINUTE 37 | HOUR_SECOND IF IGNORE IGNORE_SERVER_IDS IN INDEX INFILE INNER 38 | INOUT INSENSITIVE INSERT INT INT1 INT2 INT3 INT4 INT8 INTEGER 39 | INTERVAL INTO IS ITERATE JOIN KEY KEYS KILL LEADING LEAVE LEFT 40 | LIKE LIMIT LINEAR LINES LOAD LOCALTIME LOCALTIMESTAMP LOCK LONG 41 | LONGBLOB LONGTEXT LOOP LOW_PRIORITY MASTER_HEARTBEAT_PERIOD 42 | MASTER_SSL_VERIFY_SERVER_CERT MATCH MAXVALUE MAXVALUE MEDIUMBLOB 43 | MEDIUMINT MEDIUMTEXT MIDDLEINT MINUTE_MICROSECOND MINUTE_SECOND 44 | MOD MODIFIES NATURAL NOT NO_WRITE_TO_BINLOG NULL NUMERIC ON 45 | OPTIMIZE OPTION OPTIONALLY OR ORDER OUT OUTER OUTFILE PRECISION 46 | PRIMARY PROCEDURE PURGE RANGE READ READS READ_WRITE REAL 47 | REFERENCES REGEXP RELEASE RENAME REPEAT REPLACE REQUIRE RESIGNAL 48 | RESIGNAL RESTRICT RETURN REVOKE RIGHT RLIKE SCHEMA SCHEMAS 49 | SECOND_MICROSECOND SELECT SENSITIVE SEPARATOR SET SHOW SIGNAL 50 | SIGNAL SLOW SMALLINT SPATIAL SPECIFIC SQL SQL_BIG_RESULT 51 | SQL_CALC_FOUND_ROWS SQLEXCEPTION SQL_SMALL_RESULT SQLSTATE 52 | SQLWARNING SSL STARTING STRAIGHT_JOIN TABLE TERMINATED THEN 53 | TINYBLOB TINYINT TINYTEXT TO TRAILING TRIGGER TRUE UNDO UNION 54 | UNIQUE UNLOCK UNSIGNED UPDATE USAGE USE USING UTC_DATE UTC_TIME 55 | UTC_TIMESTAMP VALUES VARBINARY VARCHAR VARCHARACTER VARYING WHEN 56 | WHERE WHILE WITH WRITE XOR YEAR_MONTH ZEROFILL)) 57 | "List of all of MySQL's reserved words. 58 | http://dev.mysql.com/doc/refman/5.5/en/reserved-words.html") 59 | 60 | (defclass emacsql-mysql-connection (emacsql-connection) 61 | ((dbname :reader emacsql-psql-dbname :initarg :dbname) 62 | (types :allocation :class 63 | :reader emacsql-types 64 | :initform '((integer "BIGINT") 65 | (float "DOUBLE") 66 | (object "LONGTEXT") 67 | (nil "LONGTEXT")))) 68 | "A connection to a MySQL database.") 69 | 70 | (cl-defun emacsql-mysql (database &key user password host port debug) 71 | "Connect to a MySQL server using the mysql command line program." 72 | (let* ((mysql (or (executable-find emacsql-mysql-executable) 73 | (error "No mysql binary available, aborting"))) 74 | (command (list database "--skip-pager" "-rfBNL" mysql))) 75 | (when user (push (format "--user=%s" user) command)) 76 | (when password (push (format "--password=%s" password) command)) 77 | (when host (push (format "--host=%s" host) command)) 78 | (when port (push (format "--port=%s" port) command)) 79 | (let* ((process-connection-type t) 80 | (buffer (generate-new-buffer " *emacsql-mysql*")) 81 | (command (mapconcat #'shell-quote-argument (nreverse command) " ")) 82 | (process (start-process-shell-command 83 | "emacsql-mysql" buffer (concat "stty raw &&" command))) 84 | (connection (make-instance 'emacsql-mysql-connection 85 | :handle process 86 | :dbname database))) 87 | (set-process-sentinel process 88 | (lambda (proc _) (kill-buffer (process-buffer proc)))) 89 | (set-process-query-on-exit-flag (oref connection handle) nil) 90 | (when debug (emacsql-enable-debugging connection)) 91 | (emacsql connection 92 | [:set-session (= sql-mode 'NO_BACKSLASH_ESCAPES\,ANSI_QUOTES)]) 93 | (emacsql connection 94 | [:set-transaction-isolation-level :serializable]) 95 | (emacsql-register connection)))) 96 | 97 | (cl-defmethod emacsql-close ((connection emacsql-mysql-connection)) 98 | (let ((process (oref connection handle))) 99 | (when (process-live-p process) 100 | (process-send-eof process)))) 101 | 102 | (cl-defmethod emacsql-send-message ((connection emacsql-mysql-connection) message) 103 | (let ((process (oref connection handle))) 104 | (process-send-string process message) 105 | (process-send-string process "\\c\\p\n"))) 106 | 107 | (cl-defmethod emacsql-waiting-p ((connection emacsql-mysql-connection)) 108 | (let ((length (length emacsql-mysql-sentinel))) 109 | (with-current-buffer (emacsql-buffer connection) 110 | (and (>= (buffer-size) length) 111 | (progn (goto-char (- (point-max) length)) 112 | (looking-at emacsql-mysql-sentinel)))))) 113 | 114 | (cl-defmethod emacsql-parse ((connection emacsql-mysql-connection)) 115 | (with-current-buffer (emacsql-buffer connection) 116 | (let ((standard-input (current-buffer))) 117 | (goto-char (point-min)) 118 | (when (looking-at "ERROR") 119 | (search-forward ": ") 120 | (signal 'emacsql-error 121 | (list (buffer-substring (point) (line-end-position))))) 122 | (cl-loop until (looking-at emacsql-mysql-sentinel) 123 | collect (read) into row 124 | when (looking-at "\n") 125 | collect row into rows 126 | and do (setq row ()) 127 | and do (forward-char) 128 | finally (cl-return rows))))) 129 | 130 | (provide 'emacsql-mysql) 131 | 132 | ;;; emacsql-mysql.el ends here 133 | -------------------------------------------------------------------------------- /emacsql-pg.el: -------------------------------------------------------------------------------- 1 | ;;; emacsql-pg.el --- EmacSQL back-end for PostgreSQL via pg -*- lexical-binding:t -*- 2 | 3 | ;; This is free and unencumbered software released into the public domain. 4 | 5 | ;; Author: Christopher Wellons 6 | ;; Maintainer: Jonas Bernoulli 7 | 8 | ;; SPDX-License-Identifier: Unlicense 9 | 10 | ;;; Commentary: 11 | 12 | ;; This library provides an EmacSQL back-end for PostgreSQL, which 13 | ;; uses the `pg' package to directly speak to the database. This 14 | ;; library requires at least Emacs 28.1. 15 | 16 | ;; (For an alternative back-end for PostgreSQL, see `emacsql-psql'.) 17 | 18 | ;;; Code: 19 | 20 | (require 'emacsql) 21 | 22 | (if (>= emacs-major-version 28) 23 | (require 'pg nil t) 24 | (message "emacsql-pg.el requires Emacs 28.1 or later")) 25 | (declare-function pg-connect "pg" 26 | ( dbname user &optional 27 | (password "") (host "localhost") (port 5432) (tls nil))) 28 | (declare-function pg-disconnect "pg" (con)) 29 | (declare-function pg-exec "pg" (connection &rest args)) 30 | (declare-function pg-result "pg" (result what &rest arg)) 31 | 32 | (defclass emacsql-pg-connection (emacsql-connection) 33 | ((pgcon :reader emacsql-pg-pgcon :initarg :pgcon) 34 | (dbname :reader emacsql-pg-dbname :initarg :dbname) 35 | (result :accessor emacsql-pg-result) 36 | (types :allocation :class 37 | :reader emacsql-types 38 | :initform '((integer "BIGINT") 39 | (float "DOUBLE PRECISION") 40 | (object "TEXT") 41 | (nil "TEXT")))) 42 | "A connection to a PostgreSQL database via pg.el.") 43 | 44 | (cl-defun emacsql-pg (dbname user &key 45 | (host "localhost") (password "") (port 5432) debug) 46 | "Connect to a PostgreSQL server using pg.el." 47 | (require 'pg) 48 | (let* ((pgcon (pg-connect dbname user password host port)) 49 | (connection (make-instance 'emacsql-pg-connection 50 | :handle (and (fboundp 'pgcon-process) 51 | (pgcon-process pgcon)) 52 | :pgcon pgcon 53 | :dbname dbname))) 54 | (when debug (emacsql-enable-debugging connection)) 55 | (emacsql connection [:set (= default-transaction-isolation 'SERIALIZABLE)]) 56 | (emacsql-register connection))) 57 | 58 | (cl-defmethod emacsql-close ((connection emacsql-pg-connection)) 59 | (ignore-errors (pg-disconnect (emacsql-pg-pgcon connection)))) 60 | 61 | (cl-defmethod emacsql-send-message ((connection emacsql-pg-connection) message) 62 | (condition-case error 63 | (setf (emacsql-pg-result connection) 64 | (pg-exec (emacsql-pg-pgcon connection) message)) 65 | (error (signal 'emacsql-error error)))) 66 | 67 | (cl-defmethod emacsql-waiting-p ((_connection emacsql-pg-connection)) 68 | ;; pg-exec will block 69 | t) 70 | 71 | (cl-defmethod emacsql-parse ((connection emacsql-pg-connection)) 72 | (let ((tuples (pg-result (emacsql-pg-result connection) :tuples))) 73 | (cl-loop for tuple in tuples collect 74 | (cl-loop for value in tuple 75 | when (stringp value) collect (read value) 76 | else collect value)))) 77 | 78 | (provide 'emacsql-pg) 79 | 80 | ;;; emacsql-pg.el ends here 81 | -------------------------------------------------------------------------------- /emacsql-psql.el: -------------------------------------------------------------------------------- 1 | ;;; emacsql-psql.el --- EmacSQL back-end for PostgreSQL via psql -*- lexical-binding:t -*- 2 | 3 | ;; This is free and unencumbered software released into the public domain. 4 | 5 | ;; Author: Christopher Wellons 6 | ;; Maintainer: Jonas Bernoulli 7 | 8 | ;; SPDX-License-Identifier: Unlicense 9 | 10 | ;;; Commentary: 11 | 12 | ;; This library provides an EmacSQL back-end for PostgreSQL, which 13 | ;; uses the standard `psql' command line program. 14 | 15 | ;; (For an alternative back-end for PostgreSQL, see `emacsql-pg'.) 16 | 17 | ;;; Code: 18 | 19 | (require 'emacsql) 20 | 21 | (defvar emacsql-psql-executable "psql" 22 | "Path to the psql (PostgreSQL client) executable.") 23 | 24 | (defun emacsql-psql-unavailable-p () 25 | "Return a reason if the psql executable is not available. 26 | :no-executable -- cannot find the executable 27 | :cannot-execute -- cannot run the executable 28 | :old-version -- sqlite3 version is too old" 29 | (let ((psql emacsql-psql-executable)) 30 | (if (null (executable-find psql)) 31 | :no-executable 32 | (condition-case _ 33 | (with-temp-buffer 34 | (call-process psql nil (current-buffer) nil "--version") 35 | (let ((version (cl-third (split-string (buffer-string))))) 36 | (if (version< version "1.0.0") 37 | :old-version 38 | nil))) 39 | (error :cannot-execute))))) 40 | 41 | (defconst emacsql-psql-reserved 42 | (emacsql-register-reserved 43 | '( ALL ANALYSE ANALYZE AND ANY AS ASC AUTHORIZATION BETWEEN BINARY 44 | BOTH CASE CAST CHECK COLLATE COLUMN CONSTRAINT CREATE CROSS 45 | CURRENT_DATE CURRENT_TIME CURRENT_TIMESTAMP CURRENT_USER DEFAULT 46 | DEFERRABLE DESC DISTINCT DO ELSE END EXCEPT FALSE FOR FOREIGN 47 | FREEZE FROM FULL GRANT GROUP HAVING ILIKE IN INITIALLY INNER 48 | INTERSECT INTO IS ISNULL JOIN LEADING LEFT LIKE LIMIT LOCALTIME 49 | LOCALTIMESTAMP NATURAL NEW NOT NOTNULL NULL OFF OFFSET OLD ON 50 | ONLY OR ORDER OUTER OVERLAPS PLACING PRIMARY REFERENCES RIGHT 51 | SELECT SESSION_USER SIMILAR SOME TABLE THEN TO TRAILING TRUE 52 | UNION UNIQUE USER USING VERBOSE WHEN WHERE)) 53 | "List of all of PostgreSQL's reserved words. 54 | http://www.postgresql.org/docs/7.3/static/sql-keywords-appendix.html") 55 | 56 | (defclass emacsql-psql-connection (emacsql-connection) 57 | ((dbname :reader emacsql-psql-dbname :initarg :dbname) 58 | (types :allocation :class 59 | :reader emacsql-types 60 | :initform '((integer "BIGINT") 61 | (float "DOUBLE PRECISION") 62 | (object "TEXT") 63 | (nil "TEXT")))) 64 | "A connection to a PostgreSQL database via psql.") 65 | 66 | (cl-defun emacsql-psql (dbname &key username hostname port debug) 67 | "Connect to a PostgreSQL server using the psql command line program." 68 | (let ((args (list dbname))) 69 | (when username 70 | (push username args)) 71 | (push "-n" args) 72 | (when port 73 | (push "-p" args) 74 | (push port args)) 75 | (when hostname 76 | (push "-h" args) 77 | (push hostname args)) 78 | (setq args (nreverse args)) 79 | (let* ((buffer (generate-new-buffer " *emacsql-psql*")) 80 | (psql emacsql-psql-executable) 81 | (command (mapconcat #'shell-quote-argument (cons psql args) " ")) 82 | (process (start-process-shell-command 83 | "emacsql-psql" buffer (concat "stty raw && " command))) 84 | (connection (make-instance 'emacsql-psql-connection 85 | :handle process 86 | :dbname dbname))) 87 | (setf (process-sentinel process) 88 | (lambda (proc _) (kill-buffer (process-buffer proc)))) 89 | (set-process-query-on-exit-flag (oref connection handle) nil) 90 | (when debug (emacsql-enable-debugging connection)) 91 | (mapc (apply-partially #'emacsql-send-message connection) 92 | '("\\pset pager off" 93 | "\\pset null nil" 94 | "\\a" 95 | "\\t" 96 | "\\f ' '" 97 | "SET client_min_messages TO ERROR;" 98 | "\\set PROMPT1 ]" 99 | "EMACSQL;")) ; error message flush 100 | (emacsql-wait connection) 101 | (emacsql connection 102 | [:set (= default-transaction-isolation 'SERIALIZABLE)]) 103 | (emacsql-register connection)))) 104 | 105 | (cl-defmethod emacsql-close ((connection emacsql-psql-connection)) 106 | (let ((process (oref connection handle))) 107 | (when (process-live-p process) 108 | (process-send-string process "\\q\n")))) 109 | 110 | (cl-defmethod emacsql-send-message ((connection emacsql-psql-connection) message) 111 | (let ((process (oref connection handle))) 112 | (process-send-string process message) 113 | (process-send-string process "\n"))) 114 | 115 | (cl-defmethod emacsql-waiting-p ((connection emacsql-psql-connection)) 116 | (with-current-buffer (emacsql-buffer connection) 117 | (cond ((= (buffer-size) 1) (string= "]" (buffer-string))) 118 | ((> (buffer-size) 1) (string= "\n]" (buffer-substring 119 | (- (point-max) 2) 120 | (point-max))))))) 121 | 122 | (cl-defmethod emacsql-check-error ((connection emacsql-psql-connection)) 123 | (with-current-buffer (emacsql-buffer connection) 124 | (let ((case-fold-search t)) 125 | (goto-char (point-min)) 126 | (when (looking-at "error:") 127 | (let* ((beg (line-beginning-position)) 128 | (end (line-end-position))) 129 | (signal 'emacsql-error (list (buffer-substring beg end)))))))) 130 | 131 | (cl-defmethod emacsql-parse ((connection emacsql-psql-connection)) 132 | (emacsql-check-error connection) 133 | (with-current-buffer (emacsql-buffer connection) 134 | (let ((standard-input (current-buffer))) 135 | (goto-char (point-min)) 136 | (cl-loop until (looking-at "]") 137 | collect (read) into row 138 | when (looking-at "\n") 139 | collect row into rows 140 | and do (progn (forward-char 1) (setq row ())) 141 | finally (cl-return rows))))) 142 | 143 | (provide 'emacsql-psql) 144 | 145 | ;;; emacsql-psql.el ends here 146 | -------------------------------------------------------------------------------- /emacsql-sqlite-builtin.el: -------------------------------------------------------------------------------- 1 | ;;; emacsql-sqlite-builtin.el --- EmacSQL back-end for SQLite using builtin support -*- lexical-binding:t -*- 2 | 3 | ;; This is free and unencumbered software released into the public domain. 4 | 5 | ;; Author: Jonas Bernoulli 6 | ;; Maintainer: Jonas Bernoulli 7 | 8 | ;; SPDX-License-Identifier: Unlicense 9 | 10 | ;;; Commentary: 11 | 12 | ;; This library provides an EmacSQL back-end for SQLite, which uses 13 | ;; the built-in SQLite support in Emacs 29 an later. 14 | 15 | ;;; Code: 16 | 17 | (require 'emacsql-sqlite) 18 | 19 | (declare-function sqlite-open "sqlite.c") 20 | (declare-function sqlite-select "sqlite.c") 21 | (declare-function sqlite-close "sqlite.c") 22 | 23 | (emacsql-register-reserved emacsql-sqlite-reserved) 24 | 25 | (defclass emacsql-sqlite-builtin-connection (emacsql--sqlite-base) () 26 | "A connection to a SQLite database using builtin support.") 27 | 28 | (cl-defmethod initialize-instance :after 29 | ((connection emacsql-sqlite-builtin-connection) &rest _) 30 | (oset connection handle 31 | (sqlite-open (oref connection file))) 32 | (emacsql-sqlite-set-busy-timeout connection) 33 | (emacsql connection [:pragma (= foreign-keys on)]) 34 | (emacsql-register connection)) 35 | 36 | (cl-defun emacsql-sqlite-builtin (file &key debug) 37 | "Open a connected to database stored in FILE. 38 | If FILE is nil use an in-memory database. 39 | 40 | :debug LOG -- When non-nil, log all SQLite commands to a log 41 | buffer. This is for debugging purposes." 42 | (let ((connection (make-instance #'emacsql-sqlite-builtin-connection 43 | :file file))) 44 | (when debug 45 | (emacsql-enable-debugging connection)) 46 | connection)) 47 | 48 | (cl-defmethod emacsql-live-p ((connection emacsql-sqlite-builtin-connection)) 49 | (and (oref connection handle) t)) 50 | 51 | (cl-defmethod emacsql-close ((connection emacsql-sqlite-builtin-connection)) 52 | (sqlite-close (oref connection handle)) 53 | (oset connection handle nil)) 54 | 55 | (cl-defmethod emacsql-send-message 56 | ((connection emacsql-sqlite-builtin-connection) message) 57 | (condition-case err 58 | (let ((headerp emacsql-include-header)) 59 | (mapcar (lambda (row) 60 | (cond 61 | (headerp (setq headerp nil) row) 62 | ((mapcan (lambda (col) 63 | (cond ((null col) (list nil)) 64 | ((equal col "") (list "")) 65 | ((numberp col) (list col)) 66 | ((emacsql-sqlite-read-column col)))) 67 | row)))) 68 | (sqlite-select (oref connection handle) message nil 69 | (and emacsql-include-header 'full)))) 70 | ((sqlite-error sqlite-locked-error) 71 | (if (stringp (cdr err)) 72 | (signal 'emacsql-error (list (cdr err))) 73 | (pcase-let* ((`(,_ ,errstr ,errmsg ,errcode ,ext-errcode) err) 74 | (`(,_ ,_ ,signal ,_) 75 | (assq errcode emacsql-sqlite-error-codes))) 76 | (signal (or signal 'emacsql-error) 77 | (list errmsg errcode ext-errcode errstr))))) 78 | (error 79 | (signal 'emacsql-error (cdr err))))) 80 | 81 | (cl-defmethod emacsql ((connection emacsql-sqlite-builtin-connection) sql &rest args) 82 | (emacsql-send-message connection (apply #'emacsql-compile connection sql args))) 83 | 84 | (provide 'emacsql-sqlite-builtin) 85 | 86 | ;;; emacsql-sqlite-builtin.el ends here 87 | -------------------------------------------------------------------------------- /emacsql-sqlite-module.el: -------------------------------------------------------------------------------- 1 | ;;; emacsql-sqlite-module.el --- EmacSQL back-end for SQLite using a module -*- lexical-binding:t -*- 2 | 3 | ;; This is free and unencumbered software released into the public domain. 4 | 5 | ;; Author: Jonas Bernoulli 6 | ;; Maintainer: Jonas Bernoulli 7 | 8 | ;; SPDX-License-Identifier: Unlicense 9 | 10 | ;;; Commentary: 11 | 12 | ;; This library provides an EmacSQL back-end for SQLite, which uses 13 | ;; the Emacs module provided by the `sqlite3' package. 14 | 15 | ;;; Code: 16 | 17 | (require 'emacsql-sqlite) 18 | 19 | (require 'sqlite3 nil t) 20 | (declare-function sqlite3-open "ext:sqlite3-api") 21 | (declare-function sqlite3-exec "ext:sqlite3-api") 22 | (declare-function sqlite3-close "ext:sqlite3-api") 23 | (defvar sqlite-open-readwrite) 24 | (defvar sqlite-open-create) 25 | 26 | (emacsql-register-reserved emacsql-sqlite-reserved) 27 | 28 | (defclass emacsql-sqlite-module-connection (emacsql--sqlite-base) () 29 | "A connection to a SQLite database using a module.") 30 | 31 | (cl-defmethod initialize-instance :after 32 | ((connection emacsql-sqlite-module-connection) &rest _) 33 | (require (quote sqlite3)) 34 | (oset connection handle 35 | (sqlite3-open (or (oref connection file) ":memory:") 36 | sqlite-open-readwrite 37 | sqlite-open-create)) 38 | (emacsql-sqlite-set-busy-timeout connection) 39 | (emacsql connection [:pragma (= foreign-keys on)]) 40 | (emacsql-register connection)) 41 | 42 | (cl-defun emacsql-sqlite-module (file &key debug) 43 | "Open a connected to database stored in FILE. 44 | If FILE is nil use an in-memory database. 45 | 46 | :debug LOG -- When non-nil, log all SQLite commands to a log 47 | buffer. This is for debugging purposes." 48 | (let ((connection (make-instance #'emacsql-sqlite-module-connection 49 | :file file))) 50 | (when debug 51 | (emacsql-enable-debugging connection)) 52 | connection)) 53 | 54 | (cl-defmethod emacsql-live-p ((connection emacsql-sqlite-module-connection)) 55 | (and (oref connection handle) t)) 56 | 57 | (cl-defmethod emacsql-close ((connection emacsql-sqlite-module-connection)) 58 | (sqlite3-close (oref connection handle)) 59 | (oset connection handle nil)) 60 | 61 | (cl-defmethod emacsql-send-message 62 | ((connection emacsql-sqlite-module-connection) message) 63 | (condition-case err 64 | (let ((include-header emacsql-include-header) 65 | (rows ())) 66 | (sqlite3-exec (oref connection handle) 67 | message 68 | (lambda (_ row header) 69 | (when include-header 70 | (push header rows) 71 | (setq include-header nil)) 72 | (push (mapcan (lambda (col) 73 | (cond 74 | ((null col) (list nil)) 75 | ((equal col "") (list "")) 76 | ((emacsql-sqlite-read-column col)))) 77 | row) 78 | rows))) 79 | (nreverse rows)) 80 | ((db-error sql-error) 81 | (pcase-let* ((`(,_ ,errmsg ,errcode) err) 82 | (`(,_ ,_ ,signal ,errstr) 83 | (assq errcode emacsql-sqlite-error-codes))) 84 | (signal (or signal 'emacsql-error) 85 | (list errmsg errcode nil errstr)))) 86 | (error 87 | (signal 'emacsql-error (cdr err))))) 88 | 89 | (cl-defmethod emacsql ((connection emacsql-sqlite-module-connection) sql &rest args) 90 | (emacsql-send-message connection (apply #'emacsql-compile connection sql args))) 91 | 92 | (provide 'emacsql-sqlite-module) 93 | 94 | ;;; emacsql-sqlite-module.el ends here 95 | -------------------------------------------------------------------------------- /emacsql-sqlite.el: -------------------------------------------------------------------------------- 1 | ;;; emacsql-sqlite.el --- Code used by both SQLite back-ends -*- lexical-binding:t -*- 2 | 3 | ;; This is free and unencumbered software released into the public domain. 4 | 5 | ;; Author: Jonas Bernoulli 6 | ;; Maintainer: Jonas Bernoulli 7 | 8 | ;; SPDX-License-Identifier: Unlicense 9 | 10 | ;;; Commentary: 11 | 12 | ;; This library contains code that is used by both SQLite back-ends. 13 | 14 | ;;; Code: 15 | 16 | (require 'emacsql) 17 | 18 | ;;; Base class 19 | 20 | (defclass emacsql--sqlite-base (emacsql-connection) 21 | ((file :initarg :file 22 | :initform nil 23 | :type (or null string) 24 | :documentation "Database file name.") 25 | (types :allocation :class 26 | :reader emacsql-types 27 | :initform '((integer "INTEGER") 28 | (float "REAL") 29 | (object "TEXT") 30 | (nil nil)))) 31 | :abstract t) 32 | 33 | ;;; Constants 34 | 35 | (defconst emacsql-sqlite-reserved 36 | '( ABORT ACTION ADD AFTER ALL ALTER ANALYZE AND AS ASC ATTACH 37 | AUTOINCREMENT BEFORE BEGIN BETWEEN BY CASCADE CASE CAST CHECK 38 | COLLATE COLUMN COMMIT CONFLICT CONSTRAINT CREATE CROSS 39 | CURRENT_DATE CURRENT_TIME CURRENT_TIMESTAMP DATABASE DEFAULT 40 | DEFERRABLE DEFERRED DELETE DESC DETACH DISTINCT DROP EACH ELSE END 41 | ESCAPE EXCEPT EXCLUSIVE EXISTS EXPLAIN FAIL FOR FOREIGN FROM FULL 42 | GLOB GROUP HAVING IF IGNORE IMMEDIATE IN INDEX INDEXED INITIALLY 43 | INNER INSERT INSTEAD INTERSECT INTO IS ISNULL JOIN KEY LEFT LIKE 44 | LIMIT MATCH NATURAL NO NOT NOTNULL NULL OF OFFSET ON OR ORDER 45 | OUTER PLAN PRAGMA PRIMARY QUERY RAISE RECURSIVE REFERENCES REGEXP 46 | REINDEX RELEASE RENAME REPLACE RESTRICT RIGHT ROLLBACK ROW 47 | SAVEPOINT SELECT SET TABLE TEMP TEMPORARY THEN TO TRANSACTION 48 | TRIGGER UNION UNIQUE UPDATE USING VACUUM VALUES VIEW VIRTUAL WHEN 49 | WHERE WITH WITHOUT) 50 | "List of all of SQLite's reserved words. 51 | Also see http://www.sqlite.org/lang_keywords.html.") 52 | 53 | (defconst emacsql-sqlite-error-codes 54 | '((1 SQLITE_ERROR emacsql-error "SQL logic error") 55 | (2 SQLITE_INTERNAL emacsql-internal nil) 56 | (3 SQLITE_PERM emacsql-access "access permission denied") 57 | (4 SQLITE_ABORT emacsql-error "query aborted") 58 | (5 SQLITE_BUSY emacsql-locked "database is locked") 59 | (6 SQLITE_LOCKED emacsql-locked "database table is locked") 60 | (7 SQLITE_NOMEM emacsql-memory "out of memory") 61 | (8 SQLITE_READONLY emacsql-access "attempt to write a readonly database") 62 | (9 SQLITE_INTERRUPT emacsql-error "interrupted") 63 | (10 SQLITE_IOERR emacsql-access "disk I/O error") 64 | (11 SQLITE_CORRUPT emacsql-corruption "database disk image is malformed") 65 | (12 SQLITE_NOTFOUND emacsql-error "unknown operation") 66 | (13 SQLITE_FULL emacsql-access "database or disk is full") 67 | (14 SQLITE_CANTOPEN emacsql-access "unable to open database file") 68 | (15 SQLITE_PROTOCOL emacsql-access "locking protocol") 69 | (16 SQLITE_EMPTY emacsql-corruption nil) 70 | (17 SQLITE_SCHEMA emacsql-error "database schema has changed") 71 | (18 SQLITE_TOOBIG emacsql-error "string or blob too big") 72 | (19 SQLITE_CONSTRAINT emacsql-constraint "constraint failed") 73 | (20 SQLITE_MISMATCH emacsql-error "datatype mismatch") 74 | (21 SQLITE_MISUSE emacsql-error "bad parameter or other API misuse") 75 | (22 SQLITE_NOLFS emacsql-error "large file support is disabled") 76 | (23 SQLITE_AUTH emacsql-access "authorization denied") 77 | (24 SQLITE_FORMAT emacsql-corruption nil) 78 | (25 SQLITE_RANGE emacsql-error "column index out of range") 79 | (26 SQLITE_NOTADB emacsql-corruption "file is not a database") 80 | (27 SQLITE_NOTICE emacsql-warning "notification message") 81 | (28 SQLITE_WARNING emacsql-warning "warning message")) 82 | "Alist mapping SQLite error codes to EmacSQL conditions. 83 | Elements have the form (ERRCODE SYMBOLIC-NAME EMACSQL-ERROR 84 | ERRSTR). Also see https://www.sqlite.org/rescode.html.") 85 | 86 | ;;; Variables 87 | 88 | (defvar emacsql-include-header nil 89 | "Whether to include names of columns as an additional row. 90 | Never enable this globally, only let-bind it around calls to `emacsql'. 91 | Currently only supported by `emacsql-sqlite-builtin-connection' and 92 | `emacsql-sqlite-module-connection'.") 93 | 94 | (defvar emacsql-sqlite-busy-timeout 20 95 | "Seconds to wait when trying to access a table blocked by another process. 96 | See https://www.sqlite.org/c3ref/busy_timeout.html.") 97 | 98 | ;;; Utilities 99 | 100 | (defun emacsql-sqlite-connection (variable file &optional setup use-module) 101 | "Return the connection stored in VARIABLE to the database in FILE. 102 | 103 | If the value of VARIABLE is a live database connection, return that. 104 | 105 | Otherwise open a new connection to the database in FILE and store the 106 | connection in VARIABLE, before returning it. If FILE is nil, use an 107 | in-memory database. Always enable support for foreign key constrains. 108 | If optional SETUP is non-nil, it must be a function, which takes the 109 | connection as only argument. This function can be used to initialize 110 | tables, for example. 111 | 112 | If optional USE-MODULE is non-nil, then use the external module even 113 | when Emacs was built with SQLite support. This is intended for testing 114 | purposes." 115 | (or (let ((connection (symbol-value variable))) 116 | (and connection (emacsql-live-p connection) connection)) 117 | (set variable (emacsql-sqlite-open file nil setup use-module)))) 118 | 119 | (defun emacsql-sqlite-open (file &optional debug setup use-module) 120 | "Open a connection to the database stored in FILE using an SQLite back-end. 121 | 122 | Automatically use the best available back-end, as returned by 123 | `emacsql-sqlite-default-connection'. 124 | 125 | If FILE is nil, use an in-memory database. If optional DEBUG is 126 | non-nil, log all SQLite commands to a log buffer, for debugging 127 | purposes. Always enable support for foreign key constrains. 128 | 129 | If optional SETUP is non-nil, it must be a function, which takes the 130 | connection as only argument. This function can be used to initialize 131 | tables, for example. 132 | 133 | If optional USE-MODULE is non-nil, then use the external module even 134 | when Emacs was built with SQLite support. This is intended for testing 135 | purposes." 136 | (when file 137 | (make-directory (file-name-directory file) t)) 138 | (let* ((class (emacsql-sqlite-default-connection use-module)) 139 | (connection (make-instance class :file file))) 140 | (when debug 141 | (emacsql-enable-debugging connection)) 142 | (emacsql connection [:pragma (= foreign-keys on)]) 143 | (when setup 144 | (funcall setup connection)) 145 | connection)) 146 | 147 | (defun emacsql-sqlite-default-connection (&optional use-module) 148 | "Determine and return the best SQLite connection class. 149 | 150 | Signal an error if none of the connection classes can be used. 151 | 152 | If optional USE-MODULE is non-nil, then use the external module even 153 | when Emacs was built with SQLite support. This is intended for testing 154 | purposes." 155 | (or (and (not use-module) 156 | (fboundp 'sqlite-available-p) 157 | (sqlite-available-p) 158 | (require 'emacsql-sqlite-builtin) 159 | 'emacsql-sqlite-builtin-connection) 160 | (and (boundp 'module-file-suffix) 161 | module-file-suffix 162 | (condition-case nil 163 | ;; Failure modes: 164 | ;; 1. `libsqlite' shared library isn't available. 165 | ;; 2. User chooses to not compile `libsqlite'. 166 | ;; 3. `libsqlite' compilation fails. 167 | (and (require 'sqlite3) 168 | (require 'emacsql-sqlite-module) 169 | 'emacsql-sqlite-module-connection) 170 | (error 171 | (display-warning 'emacsql "\ 172 | Since your Emacs does not come with 173 | built-in SQLite support [1], but does support C modules, we can 174 | use an EmacSQL backend that relies on the third-party `sqlite3' 175 | package [2]. 176 | 177 | Please install the `sqlite3' Elisp package using your preferred 178 | Emacs package manager, and install the SQLite shared library 179 | using your distribution's package manager. That package should 180 | be named something like `libsqlite3' [3] and NOT just `sqlite3'. 181 | 182 | The legacy backend, which uses a custom SQLite executable, has 183 | been remove, so we can no longer fall back to that. 184 | 185 | [1]: Supported since Emacs 29.1, provided it was not disabled 186 | with `--without-sqlite3'. 187 | [2]: https://github.com/pekingduck/emacs-sqlite3-api 188 | [3]: On Debian https://packages.debian.org/buster/libsqlite3-0") 189 | ;; The buffer displaying the warning might immediately 190 | ;; be replaced by another buffer, before the user gets 191 | ;; a chance to see it. We cannot have that. 192 | (let (fn) 193 | (setq fn (lambda () 194 | (remove-hook 'post-command-hook fn) 195 | (pop-to-buffer (get-buffer "*Warnings*")))) 196 | (add-hook 'post-command-hook fn)) 197 | nil))) 198 | (error "EmacSQL could not find or compile a back-end"))) 199 | 200 | (defun emacsql-sqlite-set-busy-timeout (connection) 201 | (when emacsql-sqlite-busy-timeout 202 | (emacsql connection [:pragma (= busy-timeout $s1)] 203 | (* emacsql-sqlite-busy-timeout 1000)))) 204 | 205 | (defun emacsql-sqlite-read-column (string) 206 | (let ((value nil) 207 | (beg 0) 208 | (end (length string))) 209 | (while (< beg end) 210 | (let ((v (read-from-string string beg))) 211 | (push (car v) value) 212 | (setq beg (cdr v)))) 213 | (nreverse value))) 214 | 215 | (defun emacsql-sqlite-list-tables (connection) 216 | "Return a list of symbols identifying tables in CONNECTION. 217 | Tables whose names begin with \"sqlite_\", are not included 218 | in the returned value." 219 | (mapcar #'car 220 | (emacsql connection 221 | [:select name 222 | ;; The new name is `sqlite-schema', but this name 223 | ;; is supported by old and new SQLite versions. 224 | ;; See https://www.sqlite.org/schematab.html. 225 | :from sqlite-master 226 | :where (and (= type 'table) 227 | (not-like name "sqlite_%")) 228 | :order-by [(asc name)]]))) 229 | 230 | (defun emacsql-sqlite-dump-database (connection &optional versionp) 231 | "Dump the database specified by CONNECTION to a file. 232 | 233 | The dump file is placed in the same directory as the database 234 | file and its name derives from the name of the database file. 235 | The suffix is replaced with \".sql\" and if optional VERSIONP is 236 | non-nil, then the database version (the `user_version' pragma) 237 | and a timestamp are appended to the file name. 238 | 239 | Dumping is done using the official `sqlite3' binary. If that is 240 | not available and VERSIONP is non-nil, then the database file is 241 | copied instead." 242 | (let* ((version (caar (emacsql connection [:pragma user-version]))) 243 | (db (oref connection file)) 244 | (db (if (symbolp db) (symbol-value db) db)) 245 | (name (file-name-nondirectory db)) 246 | (output (concat (file-name-sans-extension db) 247 | (and versionp 248 | (concat (format "-v%s" version) 249 | (format-time-string "-%Y%m%d-%H%M"))) 250 | ".sql"))) 251 | (cond 252 | ((locate-file "sqlite3" exec-path) 253 | (when (and (file-exists-p output) versionp) 254 | (error "Cannot dump database; %s already exists" output)) 255 | (with-temp-file output 256 | (message "Dumping %s database to %s..." name output) 257 | (unless (zerop (save-excursion 258 | (call-process "sqlite3" nil t nil db ".dump"))) 259 | (error "Failed to dump %s" db)) 260 | (when version 261 | (insert (format "PRAGMA user_version=%s;\n" version))) 262 | ;; The output contains "PRAGMA foreign_keys=OFF;". 263 | ;; Change that to avoid alarming attentive users. 264 | (when (re-search-forward "^PRAGMA foreign_keys=\\(OFF\\);" 1000 t) 265 | (replace-match "ON" t t nil 1)) 266 | (message "Dumping %s database to %s...done" name output))) 267 | (versionp 268 | (setq output (concat (file-name-sans-extension output) ".db")) 269 | (message "Cannot dump database because sqlite3 binary cannot be found") 270 | (when (and (file-exists-p output) versionp) 271 | (error "Cannot copy database; %s already exists" output)) 272 | (message "Copying %s database to %s..." name output) 273 | (copy-file db output) 274 | (message "Copying %s database to %s...done" name output)) 275 | ((error "Cannot dump database; sqlite3 binary isn't available"))))) 276 | 277 | (defun emacsql-sqlite-restore-database (db dump) 278 | "Restore database DB from DUMP. 279 | 280 | DUMP is a file containing SQL statements. DB can be the file 281 | in which the database is to be stored, or it can be a database 282 | connection. In the latter case the current database is first 283 | dumped to a new file and the connection is closed. Then the 284 | database is restored from DUMP. No connection to the new 285 | database is created." 286 | (unless (stringp db) 287 | (emacsql-sqlite-dump-database db t) 288 | (emacsql-close (prog1 db (setq db (oref db file))))) 289 | (with-temp-buffer 290 | (unless (zerop (call-process "sqlite3" nil t nil db 291 | (format ".read %s" dump))) 292 | (error "Failed to read %s: %s" dump (buffer-string))))) 293 | 294 | (provide 'emacsql-sqlite) 295 | 296 | ;;; emacsql-sqlite.el ends here 297 | -------------------------------------------------------------------------------- /emacsql.el: -------------------------------------------------------------------------------- 1 | ;;; emacsql.el --- High-level SQL database front-end -*- lexical-binding:t -*- 2 | 3 | ;; This is free and unencumbered software released into the public domain. 4 | 5 | ;; Author: Christopher Wellons 6 | ;; Maintainer: Jonas Bernoulli 7 | ;; Homepage: https://github.com/magit/emacsql 8 | 9 | ;; Package-Version: 4.3.1 10 | ;; Package-Requires: ((emacs "26.1")) 11 | 12 | ;; SPDX-License-Identifier: Unlicense 13 | 14 | ;;; Commentary: 15 | 16 | ;; EmacSQL is a high-level Emacs Lisp front-end for SQLite. 17 | 18 | ;; PostgreSQL and MySQL are also supported, but use of these connectors 19 | ;; is not recommended. 20 | 21 | ;; See README.md for much more complete documentation. 22 | 23 | ;;; Code: 24 | 25 | (require 'cl-lib) 26 | (require 'cl-generic) 27 | (require 'eieio) 28 | 29 | (require 'emacsql-compiler) 30 | 31 | (defgroup emacsql nil 32 | "The EmacSQL SQL database front-end." 33 | :group 'comm) 34 | 35 | (defconst emacsql-version "4.3.1") 36 | 37 | (defvar emacsql-global-timeout 30 38 | "Maximum number of seconds to wait before bailing out on a SQL command. 39 | If nil, wait forever. This is used by the `mysql', `pg' and `psql'. It 40 | is not being used by the `sqlite-builtin' and `sqlite-module' back-ends, 41 | which respect `emacsql-sqlite-busy-timeout' instead.") 42 | 43 | ;;; Database connection 44 | 45 | (defclass emacsql-connection () 46 | ((handle :initarg :handle 47 | :documentation "Internal connection handler. 48 | The value is a record-like object and should not be accessed 49 | directly. Depending on the concrete implementation, `type-of' 50 | may return `process', `user-ptr' or `sqlite' for this value.") 51 | (log-buffer :type (or null buffer) 52 | :initarg :log-buffer 53 | :initform nil 54 | :documentation "Output log (debug).") 55 | (finalizer :documentation "Object returned from `make-finalizer'.") 56 | (types :allocation :class 57 | :initform nil 58 | :reader emacsql-types 59 | :documentation "Maps EmacSQL types to SQL types.")) 60 | "A connection to a SQL database." 61 | :abstract t) 62 | 63 | (cl-defgeneric emacsql-close (connection) 64 | "Close CONNECTION and free all resources.") 65 | 66 | (cl-defgeneric emacsql-reconnect (connection) 67 | "Re-establish CONNECTION with the same parameters.") 68 | 69 | (cl-defmethod emacsql-live-p ((connection emacsql-connection)) 70 | "Return non-nil if CONNECTION is still alive and ready." 71 | (and (process-live-p (oref connection handle)) t)) 72 | 73 | (cl-defgeneric emacsql-types (connection) 74 | "Return an alist mapping EmacSQL types to database types. 75 | This will mask `emacsql-type-map' during expression compilation. 76 | This alist should have four key symbols: integer, float, object, 77 | nil (default type). The values are strings to be inserted into 78 | a SQL expression.") 79 | 80 | (cl-defmethod emacsql-buffer ((connection emacsql-connection)) 81 | "Get process buffer for CONNECTION." 82 | (process-buffer (oref connection handle))) 83 | 84 | (cl-defmethod emacsql-enable-debugging ((connection emacsql-connection)) 85 | "Enable debugging on CONNECTION." 86 | (unless (buffer-live-p (oref connection log-buffer)) 87 | (oset connection log-buffer (generate-new-buffer " *emacsql-log*")))) 88 | 89 | (cl-defmethod emacsql-log ((connection emacsql-connection) message) 90 | "Log MESSAGE into CONNECTION's log. 91 | MESSAGE should not have a newline on the end." 92 | (let ((buffer (oref connection log-buffer))) 93 | (when buffer 94 | (unless (buffer-live-p buffer) 95 | (setq buffer (emacsql-enable-debugging connection))) 96 | (with-current-buffer buffer 97 | (goto-char (point-max)) 98 | (princ (concat message "\n") buffer))))) 99 | 100 | ;;; Sending and receiving 101 | 102 | (cl-defgeneric emacsql-send-message (connection message) 103 | "Send MESSAGE to CONNECTION.") 104 | 105 | (cl-defmethod emacsql-send-message :before 106 | ((connection emacsql-connection) message) 107 | (emacsql-log connection message)) 108 | 109 | (cl-defmethod emacsql-clear ((connection emacsql-connection)) 110 | "Clear the connection buffer for CONNECTION-SPEC." 111 | (let ((buffer (emacsql-buffer connection))) 112 | (when (and buffer (buffer-live-p buffer)) 113 | (with-current-buffer buffer 114 | (erase-buffer))))) 115 | 116 | (cl-defgeneric emacsql-waiting-p (connection) 117 | "Return non-nil if CONNECTION is ready for more input.") 118 | 119 | (cl-defmethod emacsql-wait ((connection emacsql-connection) &optional timeout) 120 | "Block until CONNECTION is waiting for further input." 121 | (let* ((real-timeout (or timeout emacsql-global-timeout)) 122 | (end (and real-timeout (+ (float-time) real-timeout)))) 123 | (while (and (or (null real-timeout) (< (float-time) end)) 124 | (not (emacsql-waiting-p connection))) 125 | (save-match-data 126 | (accept-process-output (oref connection handle) real-timeout))) 127 | (unless (emacsql-waiting-p connection) 128 | (signal 'emacsql-timeout (list "Query timed out" real-timeout))))) 129 | 130 | (cl-defgeneric emacsql-parse (connection) 131 | "Return the results of parsing the latest output or signal an error.") 132 | 133 | (defun emacsql-compile (connection sql &rest args) 134 | "Compile s-expression SQL for CONNECTION into a string." 135 | (let ((emacsql-type-map (or (and connection (emacsql-types connection)) 136 | emacsql-type-map))) 137 | (concat (apply #'emacsql-format (emacsql-prepare sql) args) ";"))) 138 | 139 | (cl-defgeneric emacsql (connection sql &rest args) 140 | "Send SQL s-expression to CONNECTION and return the results.") 141 | 142 | (cl-defmethod emacsql ((connection emacsql-connection) sql &rest args) 143 | (let ((sql-string (apply #'emacsql-compile connection sql args))) 144 | (emacsql-clear connection) 145 | (emacsql-send-message connection sql-string) 146 | (emacsql-wait connection) 147 | (emacsql-parse connection))) 148 | 149 | ;;; Helper mixin class 150 | 151 | (defclass emacsql-protocol-mixin () () 152 | "A mixin for back-ends following the EmacSQL protocol. 153 | The back-end prompt must be a single \"]\" character. This prompt 154 | value was chosen because it is unreadable. Output must have 155 | exactly one row per line, fields separated by whitespace. NULL 156 | must display as \"nil\"." 157 | :abstract t) 158 | 159 | (cl-defmethod emacsql-waiting-p ((connection emacsql-protocol-mixin)) 160 | "Return t if the end of the buffer has a properly-formatted prompt. 161 | Also return t if the connection buffer has been killed." 162 | (let ((buffer (emacsql-buffer connection))) 163 | (or (not (buffer-live-p buffer)) 164 | (with-current-buffer buffer 165 | (and (>= (buffer-size) 2) 166 | (string= "#\n" 167 | (buffer-substring (- (point-max) 2) (point-max)))))))) 168 | 169 | (cl-defmethod emacsql-handle ((_ emacsql-protocol-mixin) code message) 170 | "Signal a specific condition for CODE from CONNECTION. 171 | Subclasses should override this method in order to provide more 172 | specific error conditions." 173 | (signal 'emacsql-error (list message code))) 174 | 175 | (cl-defmethod emacsql-parse ((connection emacsql-protocol-mixin)) 176 | "Parse well-formed output into an s-expression." 177 | (with-current-buffer (emacsql-buffer connection) 178 | (goto-char (point-min)) 179 | (let* ((standard-input (current-buffer)) 180 | (value (read))) 181 | (if (eq value 'error) 182 | (emacsql-handle connection (read) (read)) 183 | (prog1 value 184 | (unless (eq (read) 'success) 185 | (emacsql-handle connection (read) (read)))))))) 186 | 187 | ;;; Automatic connection cleanup 188 | 189 | (defun emacsql-register (connection) 190 | "Register CONNECTION for automatic cleanup and return CONNECTION." 191 | (prog1 connection 192 | (oset connection finalizer 193 | (make-finalizer (lambda () (emacsql-close connection)))))) 194 | 195 | ;;; Useful macros 196 | 197 | (defmacro emacsql-with-connection (connection-spec &rest body) 198 | "Open an EmacSQL connection, evaluate BODY, and close the connection. 199 | CONNECTION-SPEC establishes a single binding. 200 | 201 | (emacsql-with-connection (db (emacsql-sqlite \"company.db\")) 202 | (emacsql db [:create-table foo [x]]) 203 | (emacsql db [:insert :into foo :values ([1] [2] [3])]) 204 | (emacsql db [:select * :from foo]))" 205 | (declare (indent 1)) 206 | `(let ((,(car connection-spec) ,(cadr connection-spec))) 207 | (unwind-protect 208 | (progn ,@body) 209 | (emacsql-close ,(car connection-spec))))) 210 | 211 | (defvar emacsql--transaction-level 0 212 | "Keeps track of nested transactions in `emacsql-with-transaction'.") 213 | 214 | (defmacro emacsql-with-transaction (connection &rest body) 215 | "Evaluate BODY inside a single transaction, issuing a rollback on error. 216 | This macro can be nested indefinitely, wrapping everything in a 217 | single transaction at the lowest level. 218 | 219 | Warning: BODY should *not* have any side effects besides making 220 | changes to the database behind CONNECTION. Body may be evaluated 221 | multiple times before the changes are committed." 222 | (declare (indent 1)) 223 | `(let ((emacsql--connection ,connection) 224 | (emacsql--completed nil) 225 | (emacsql--transaction-level (1+ emacsql--transaction-level)) 226 | (emacsql--result)) 227 | (unwind-protect 228 | (while (not emacsql--completed) 229 | (condition-case nil 230 | (progn 231 | (when (= 1 emacsql--transaction-level) 232 | (emacsql emacsql--connection [:begin])) 233 | (let ((result (progn ,@body))) 234 | (setq emacsql--result result) 235 | (when (= 1 emacsql--transaction-level) 236 | (emacsql emacsql--connection [:commit])) 237 | (setq emacsql--completed t))) 238 | (emacsql-locked (emacsql emacsql--connection [:rollback]) 239 | (sleep-for 0.05)))) 240 | (when (and (= 1 emacsql--transaction-level) 241 | (not emacsql--completed)) 242 | (emacsql emacsql--connection [:rollback]))) 243 | emacsql--result)) 244 | 245 | (defmacro emacsql-thread (connection &rest statements) 246 | "Thread CONNECTION through STATEMENTS. 247 | A statement can be a list, containing a statement with its arguments." 248 | (declare (indent 1)) 249 | `(let ((emacsql--conn ,connection)) 250 | (emacsql-with-transaction emacsql--conn 251 | ,@(cl-loop for statement in statements 252 | when (vectorp statement) 253 | collect (list 'emacsql 'emacsql--conn statement) 254 | else 255 | collect (append (list 'emacsql 'emacsql--conn) statement))))) 256 | 257 | (defmacro emacsql-with-bind (connection sql-and-args &rest body) 258 | "For each result row bind the column names for each returned row. 259 | Returns the result of the last evaluated BODY. 260 | 261 | All column names must be provided in the query ($ and * are not 262 | allowed). Hint: all of the bound identifiers must be known at 263 | compile time. For example, in the expression below the variables 264 | `name' and `phone' will be bound for the body. 265 | 266 | (emacsql-with-bind db [:select [name phone] :from people] 267 | (message \"Found %s with %s\" name phone)) 268 | 269 | (emacsql-with-bind db ([:select [name phone] 270 | :from people 271 | :where (= name $1)] my-name) 272 | (message \"Found %s with %s\" name phone)) 273 | 274 | Each column must be a plain symbol, no expressions allowed here." 275 | (declare (indent 2)) 276 | (let ((sql (if (vectorp sql-and-args) sql-and-args (car sql-and-args))) 277 | (args (and (not (vectorp sql-and-args)) (cdr sql-and-args)))) 278 | (cl-assert (eq :select (elt sql 0))) 279 | (let ((vars (elt sql 1))) 280 | (when (eq vars '*) 281 | (error "Must explicitly list columns in `emacsql-with-bind'")) 282 | (cl-assert (cl-every #'symbolp vars)) 283 | `(let ((emacsql--results (emacsql ,connection ,sql ,@args)) 284 | (emacsql--final nil)) 285 | (dolist (emacsql--result emacsql--results emacsql--final) 286 | (setq emacsql--final 287 | (cl-destructuring-bind ,(cl-coerce vars 'list) emacsql--result 288 | ,@body))))))) 289 | 290 | ;;; User interaction functions 291 | 292 | (defvar emacsql-show-buffer-name "*emacsql-show*" 293 | "Name of the buffer for displaying intermediate SQL.") 294 | 295 | (defun emacsql--indent () 296 | "Indent and wrap the SQL expression in the current buffer." 297 | (save-excursion 298 | (goto-char (point-min)) 299 | (let ((case-fold-search nil)) 300 | (while (search-forward-regexp " [A-Z]+" nil :no-error) 301 | (when (> (current-column) (* fill-column 0.8)) 302 | (backward-word) 303 | (insert "\n ")))))) 304 | 305 | (defun emacsql-show-sql (string) 306 | "Fontify and display the SQL expression in STRING." 307 | (let ((fontified 308 | (with-temp-buffer 309 | (insert string) 310 | (sql-mode) 311 | (with-no-warnings ;; autoloaded by previous line 312 | (sql-highlight-sqlite-keywords)) 313 | (font-lock-ensure) 314 | (emacsql--indent) 315 | (buffer-string)))) 316 | (with-current-buffer (get-buffer-create emacsql-show-buffer-name) 317 | (if (< (length string) fill-column) 318 | (message "%s" fontified) 319 | (let ((buffer-read-only nil)) 320 | (erase-buffer) 321 | (insert fontified)) 322 | (special-mode) 323 | (visual-line-mode) 324 | (pop-to-buffer (current-buffer)))))) 325 | 326 | (defun emacsql-flatten-sql (sql) 327 | "Convert a s-expression SQL into a flat string for display." 328 | (cl-destructuring-bind (string . vars) (emacsql-prepare sql) 329 | (concat 330 | (apply #'format string (cl-loop for i in (mapcar #'car vars) 331 | collect (intern (format "$%d" (1+ i))))) 332 | ";"))) 333 | 334 | ;;;###autoload 335 | (defun emacsql-show-last-sql (&optional prefix) 336 | "Display the compiled SQL of the s-expression SQL expression before point. 337 | A prefix argument causes the SQL to be printed into the current buffer." 338 | (interactive "P") 339 | (let ((sexp (if (fboundp 'elisp--preceding-sexp) 340 | (elisp--preceding-sexp) 341 | (with-no-warnings 342 | (preceding-sexp))))) 343 | (if (emacsql-sql-p sexp) 344 | (let ((sql (emacsql-flatten-sql sexp))) 345 | (if prefix 346 | (insert sql) 347 | (emacsql-show-sql sql))) 348 | (user-error "Invalid SQL: %S" sexp)))) 349 | 350 | ;;; Fix Emacs' broken vector indentation 351 | 352 | (defun emacsql--inside-vector-p () 353 | "Return non-nil if point is inside a vector expression." 354 | (let ((start (point))) 355 | (save-excursion 356 | (beginning-of-defun) 357 | (let ((containing-sexp (elt (parse-partial-sexp (point) start) 1))) 358 | (and containing-sexp 359 | (progn (goto-char containing-sexp) 360 | (looking-at "\\["))))))) 361 | 362 | (defun emacsql--calculate-vector-indent (fn &optional parse-start) 363 | "Don't indent vectors in `emacs-lisp-mode' like lists." 364 | (if (save-excursion (beginning-of-line) (emacsql--inside-vector-p)) 365 | (let ((lisp-indent-offset 1)) 366 | (funcall fn parse-start)) 367 | (funcall fn parse-start))) 368 | 369 | (defun emacsql-fix-vector-indentation () 370 | "When called, advise `calculate-lisp-indent' to stop indenting vectors. 371 | Once activated, vector contents no longer indent like lists." 372 | (interactive) 373 | (advice-add 'calculate-lisp-indent :around 374 | #'emacsql--calculate-vector-indent)) 375 | 376 | (provide 'emacsql) 377 | 378 | ;;; emacsql.el ends here 379 | -------------------------------------------------------------------------------- /tests/.nosearch: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/magit/emacsql/ced062890061b6e4fbe4d00c0617f7ff84fff25c/tests/.nosearch -------------------------------------------------------------------------------- /tests/emacsql-compiler-tests.el: -------------------------------------------------------------------------------- 1 | ;;; emacsql-tests.el --- Tests for emacsql -*- lexical-binding:t -*- 2 | 3 | ;; This is free and unencumbered software released into the public domain. 4 | 5 | ;;; Code: 6 | 7 | (require 'ert) 8 | (require 'emacsql) 9 | 10 | (ert-deftest emacsql-escape-identifier () 11 | (should-error (emacsql-escape-identifier "foo")) 12 | (should (string= (emacsql-escape-identifier 'foo) "foo")) 13 | (should (string= (emacsql-escape-identifier 'a\ b) "\"a\\ b\"")) 14 | (should (string= (emacsql-escape-identifier '$foo) "\"$foo\"")) 15 | (emacsql-register-reserved '(SELECT)) 16 | (should (string= (emacsql-escape-identifier 'select) "\"select\"")) 17 | (should-error (emacsql-escape-identifier 10)) 18 | (should-error (emacsql-escape-identifier nil)) 19 | (should (string= (emacsql-escape-identifier 'person-id) "person_id")) 20 | (should (string= (emacsql-escape-identifier 'people:person-id) 21 | "people.person_id")) 22 | (should (string= (emacsql-escape-identifier 'foo$) "foo$")) 23 | (should (string= (emacsql-escape-identifier 'foo:bar) "foo.bar"))) 24 | 25 | (ert-deftest emacsql-escape-scalar () 26 | (should (string= (emacsql-escape-scalar 'foo) "'foo'")) 27 | (should (string= (emacsql-escape-scalar "foo") "'\"foo\"'")) 28 | (should (string= (emacsql-escape-scalar :foo) "':foo'")) 29 | (should (string= (emacsql-escape-scalar [1 2 3]) "'[1 2 3]'")) 30 | (should (string= (emacsql-escape-scalar '(a b c)) "'(a b c)'")) 31 | (should (string= (emacsql-escape-scalar nil) "NULL"))) 32 | 33 | (ert-deftest emacsql-escape-vector () 34 | (should (string= (emacsql-escape-vector [1 2 3]) "(1, 2, 3)")) 35 | (should (string= (emacsql-escape-vector '([1 2 3])) "(1, 2, 3)")) 36 | (should (string= (emacsql-escape-vector '([1 2 3] [4 5 6])) 37 | "(1, 2, 3), (4, 5, 6)"))) 38 | 39 | (ert-deftest emacsql-escape-raw () 40 | (should (string= (emacsql-escape-raw "/var/emacsql") "'/var/emacsql'")) 41 | (should (string= (emacsql-escape-raw "a b c") "'a b c'")) 42 | (should (string= (emacsql-escape-raw "a 'b' c") "'a ''b'' c'")) 43 | (should (string= (emacsql-escape-raw nil) "NULL"))) 44 | 45 | (ert-deftest emacsql-schema () 46 | (should (string= (emacsql-prepare-schema [a]) "a &NONE")) 47 | (should (string= (emacsql-prepare-schema [a b c]) 48 | "a &NONE, b &NONE, c &NONE")) 49 | (should (string= (emacsql-prepare-schema [a (b)]) 50 | "a &NONE, b &NONE")) 51 | (should (string= (emacsql-prepare-schema [a (b float)]) 52 | "a &NONE, b &REAL")) 53 | (should (string= (emacsql-prepare-schema 54 | [a (b float :primary-key :unique)]) 55 | "a &NONE, b &REAL PRIMARY KEY UNIQUE")) 56 | (should (string= (emacsql-prepare-schema [(a integer) (b float)]) 57 | "a &INTEGER, b &REAL"))) 58 | 59 | (ert-deftest emacsql-param () 60 | (should (equal (emacsql-param 'a) nil)) 61 | (should (equal (emacsql-param 0) nil)) 62 | (should (equal (emacsql-param "") nil)) 63 | (should (equal (emacsql-param '$) nil)) 64 | (should (equal (emacsql-param '$1) nil)) 65 | (should (equal (emacsql-param '$s5) '(4 . :scalar))) 66 | (should (equal (emacsql-param '$v10) '(9 . :vector))) 67 | (should (equal (emacsql-param '$r2) '(1 . :raw))) 68 | (should (equal (emacsql-param '$a) nil)) 69 | (should (equal (emacsql-param '$i10) '(9 . :identifier)))) 70 | 71 | (defun emacsql-tests-query (query args result) 72 | "Check that QUERY outputs RESULT for ARGS." 73 | (should (string= (apply #'emacsql-compile nil query args) 74 | result))) 75 | 76 | (defmacro emacsql-tests-with-queries (&rest queries) 77 | "Thread `emacsql-tests-query' through QUERIES." 78 | (declare (indent 0)) 79 | (cons 'progn (mapcar (lambda (q) (cons 'emacsql-tests-query q)) queries))) 80 | 81 | (ert-deftest emacsql-select () 82 | (emacsql-tests-with-queries 83 | ([:select [$i1 name] :from $i2] '(id people) 84 | "SELECT id, name FROM people;") 85 | ([:select * :from employees] '() 86 | "SELECT * FROM employees;") 87 | ([:select * :from employees :where (< salary 50000)] '() 88 | "SELECT * FROM employees WHERE salary < 50000;") 89 | ([:select * :from people :where (in name $v1)] '([FOO BAR]) 90 | "SELECT * FROM people WHERE name IN ('FOO', 'BAR');") 91 | ;; Sub queries 92 | ([:select name :from [:select * :from $i1]] '(people) 93 | "SELECT name FROM (SELECT * FROM people);") 94 | ([:select name :from [people (as accounts a)]] '() 95 | "SELECT name FROM people, accounts AS a;") 96 | ([:select p:name :from [(as [:select * :from people] p)]] '() 97 | "SELECT p.name FROM (SELECT * FROM people) AS p;"))) 98 | 99 | (ert-deftest emacsql-attach () 100 | (emacsql-tests-with-queries 101 | ([:attach $r1 :as $i2] '("/var/foo.db" foo) 102 | "ATTACH '/var/foo.db' AS foo;") 103 | ([:detach $i1] '(foo) 104 | "DETACH foo;"))) 105 | 106 | (ert-deftest emacsql-create-table () 107 | (emacsql-tests-with-queries 108 | ([:create-table foo ([a b c])] () 109 | "CREATE TABLE foo (a &NONE, b &NONE, c &NONE);") 110 | ([:create-temporary-table :if-not-exists x ([y])] '() 111 | "CREATE TEMPORARY TABLE IF NOT EXISTS x (y &NONE);") 112 | ([:create-table foo ([(a :default 10)])] '() 113 | "CREATE TABLE foo (a &NONE DEFAULT 10);") 114 | ([:create-table foo ([(a :primary-key :not-null) b])] '() 115 | "CREATE TABLE foo (a &NONE PRIMARY KEY NOT NULL, b &NONE);") 116 | ([:create-table foo ([a (b :check (< b 10))])] '() 117 | "CREATE TABLE foo (a &NONE, b &NONE CHECK (b < 10));") 118 | ([:create-table foo $S1] '([a b (c :primary-key)]) 119 | "CREATE TABLE foo (a &NONE, b &NONE, c &NONE PRIMARY KEY);") 120 | ([:create-table foo ([a b (c :default "FOO")])] '() 121 | "CREATE TABLE foo (a &NONE, b &NONE, c &NONE DEFAULT '\"FOO\"');") 122 | ;; From select 123 | ([:create-table $i1 :as [:select name :from $i2]] '(names people) 124 | "CREATE TABLE names AS (SELECT name FROM people);") 125 | ;; Table constraints 126 | ([:create-table foo ([a b c] (:primary-key [a c]))] '() 127 | "CREATE TABLE foo (a &NONE, b &NONE, c &NONE, PRIMARY KEY (a, c));") 128 | ([:create-table foo ([a b c] (:unique [a b c]))] '() 129 | "CREATE TABLE foo (a &NONE, b &NONE, c &NONE, UNIQUE (a, b, c));") 130 | ([:create-table foo ([a b] (:check (< a b)))] '() 131 | "CREATE TABLE foo (a &NONE, b &NONE, CHECK (a < b));") 132 | ([:create-table foo ([a b c] 133 | ( :foreign-key [a b] 134 | :references bar [aa bb] 135 | :on-delete :cascade))] 136 | '() 137 | (concat "CREATE TABLE foo (a &NONE, b &NONE, c &NONE, FOREIGN KEY (a, b) " 138 | "REFERENCES bar (aa, bb) ON DELETE CASCADE);")) 139 | ;; Template 140 | ([:create-table $i1 $S2] '(foo [alpha beta delta]) 141 | "CREATE TABLE foo (alpha &NONE, beta &NONE, delta &NONE);") 142 | ;; Drop table 143 | ([:drop-table $i1] '(foo) 144 | "DROP TABLE foo;"))) 145 | 146 | (ert-deftest emacsql-update () 147 | (emacsql-tests-with-queries 148 | ([:update people :set (= id $s1)] '(10) 149 | "UPDATE people SET id = 10;"))) 150 | 151 | (ert-deftest emacsql-insert () 152 | (emacsql-tests-with-queries 153 | ([:insert :into foo :values [nil $s1]] '(10.1) 154 | "INSERT INTO foo VALUES (NULL, 10.1);") 155 | ([:insert :into foo [a b] :values $v1] '([1 2]) 156 | "INSERT INTO foo (a, b) VALUES (1, 2);") 157 | ([:replace :into $i1 :values $v2] '(bar ([1 2] [3 4])) 158 | "REPLACE INTO bar VALUES (1, 2), (3, 4);"))) 159 | 160 | (ert-deftest emacsql-order-by () 161 | (emacsql-tests-with-queries 162 | ([:order-by foo] '() 163 | "ORDER BY foo;") 164 | ([:order-by [$i1]] '(bar) 165 | "ORDER BY bar;") 166 | ([:order-by (- foo)] '() 167 | "ORDER BY -foo;") 168 | ([:order-by [(asc a) (desc (/ b 2))]] '() 169 | "ORDER BY a ASC, b / 2 DESC;"))) 170 | 171 | (ert-deftest emacsql-limit () 172 | (emacsql-tests-with-queries 173 | ([:limit 10] '() 174 | "LIMIT 10;") 175 | ([:limit $s1] '(11) 176 | "LIMIT 11;") 177 | ([:limit [12]] '() 178 | "LIMIT 12;") 179 | ([:limit [2 10]] '() 180 | "LIMIT 2, 10;") 181 | ([:limit [$s1 $s2]] '(4 30) 182 | "LIMIT 4, 30;"))) 183 | 184 | (ert-deftest emacsql-quoting () 185 | (emacsql-tests-with-queries 186 | ([:where (= name 'foo)] '() 187 | "WHERE name = 'foo';") 188 | ([:where (= name '$s1)] '(qux) 189 | "WHERE name = 'qux';") 190 | ([:where (like url (escape "%`%%" ?`))] '() 191 | "WHERE url LIKE '\"%`%%\"' ESCAPE '`';"))) 192 | 193 | (ert-deftest emacsql-expr () 194 | (emacsql-tests-with-queries 195 | ([:where (and a b)] '() 196 | "WHERE a AND b;") 197 | ([:where (or a $i1)] '(b) 198 | "WHERE a OR b;") 199 | ([:where (and $i1 $i2 $i3)] '(a b c) 200 | "WHERE a AND b AND c;") 201 | ([:where (is foo (not nil))] '() 202 | "WHERE foo IS (NOT NULL);") 203 | ([:where (is-not foo nil)] '() 204 | "WHERE foo IS NOT NULL;") 205 | ([:where (= attrib :name)] '() 206 | "WHERE attrib = ':name';"))) 207 | 208 | (ert-deftest emacsql-transaction () 209 | (emacsql-tests-with-queries 210 | ([:begin :transaction] '() 211 | "BEGIN TRANSACTION;") 212 | ([:begin :immediate] '() 213 | "BEGIN IMMEDIATE;") 214 | ([:rollback] '() 215 | "ROLLBACK;") 216 | ([:commit] '() 217 | "COMMIT;"))) 218 | 219 | (ert-deftest emacsql-alter-table () 220 | (emacsql-tests-with-queries 221 | ([:alter-table foo :rename-to bar] '() 222 | "ALTER TABLE foo RENAME TO bar;") 223 | ([:alter-table $i1 :rename-to $i2] '(alpha beta) 224 | "ALTER TABLE alpha RENAME TO beta;") 225 | ([:alter-table foo :add-column size :integer :not-null] '() 226 | "ALTER TABLE foo ADD COLUMN size INTEGER NOT NULL;"))) 227 | 228 | (ert-deftest emacsql-funcall () 229 | (emacsql-tests-with-queries 230 | ([:select (funcall count x)] '() 231 | "SELECT count(x);") 232 | ([:select (funcall count *)] '() 233 | "SELECT count(*);") 234 | ([:select (funcall group-concat x y)] '() 235 | "SELECT group_concat(x, y);") 236 | ([:select (funcall foobar :distinct x y)] '() 237 | "SELECT foobar(':distinct', x, y);") 238 | ([:select (funcall count :distinct x)] '() 239 | "SELECT count(DISTINCT x);"))) 240 | 241 | (ert-deftest emacsql-precedence () 242 | (emacsql-tests-with-queries 243 | ([:select (<< (not (is x nil)) 4)] '() 244 | "SELECT (NOT x IS NULL) << 4;") 245 | ([:select (* 3 (+ (/ 14 2) (- 5 3)))] '() 246 | "SELECT 3 * (14 / 2 + (5 - 3));") 247 | ([:select (- (|| (~ x) y))] '() 248 | "SELECT -~x || y;") 249 | ([:select (funcall length (|| (* x x) (* y y) (* z z)))] '() 250 | "SELECT length((x * x) || (y * y) || (z * z));") 251 | ([:select (and (+ (<= x y) 1) (>= y x))] '() 252 | "SELECT (x <= y) + 1 AND y >= x;") 253 | ([:select (or (& (<= x (+ y 1) (- z)) 1) (>= x z y))] '() 254 | "SELECT (y + 1 BETWEEN x AND -z) & 1 OR z BETWEEN y AND x;"))) 255 | 256 | ;;; emacsql-tests.el ends here 257 | -------------------------------------------------------------------------------- /tests/emacsql-external-tests.el: -------------------------------------------------------------------------------- 1 | ;;; emacsql-external-tests.el --- Subprocess tests -*- lexical-binding:t -*- 2 | 3 | ;; This is free and unencumbered software released into the public domain. 4 | 5 | ;;; Code: 6 | 7 | (require 'cl-lib) 8 | (require 'ert) 9 | (require 'emacsql) 10 | 11 | (defvar emacsql-tests-timeout 4 12 | "Be aggressive about not waiting on subprocesses in unit tests.") 13 | 14 | (defvar emacsql-tests-connection-factories nil 15 | "List of connection factories to use in unit tests.") 16 | 17 | (defun emacsql-tests-add-connection-factory 18 | (connector &optional dep min pred envvars) 19 | (declare (indent defun)) 20 | (cond 21 | ((and min (version< emacs-version min)) 22 | (message " ! skip `%s'; requires Emacs >= %s" connector min)) 23 | ((and dep (not (with-demoted-errors "%S" (require dep nil t)))) 24 | (message " ! skip `%s'; library `%s' not available" connector dep)) 25 | ((and pred (not (funcall pred))) 26 | (message " ! skip `%s'; sanity check failed" connector)) 27 | ((not (with-demoted-errors "%S" (require connector nil t))) 28 | (message " ! skip `%s'; failed to load library" connector)) 29 | ((let* ((unset ()) 30 | (args (if envvars 31 | (mapcan (lambda (var) 32 | (let* ((envvar (car var)) 33 | (keyword (cadr var)) 34 | (value (and envvar (getenv envvar)))) 35 | (cond ((not value) (push envvar unset) nil) 36 | (keyword (list keyword value)) 37 | ((list value))))) 38 | envvars) 39 | (list nil)))) 40 | (if unset 41 | (message " ! skip `%s'; required envvars not set" connector) 42 | (message " test `%s' connector" connector) 43 | (push (apply #'apply-partially connector args) 44 | emacsql-tests-connection-factories)))))) 45 | 46 | (cl-eval-when (load eval) 47 | (emacsql-tests-add-connection-factory 'emacsql-sqlite-builtin 'sqlite "29.1" 48 | 'sqlite-available-p) 49 | 50 | (emacsql-tests-add-connection-factory 'emacsql-sqlite-module 'sqlite3 nil 51 | (lambda () (boundp 'module-file-suffix))) 52 | 53 | (emacsql-tests-add-connection-factory 'emacsql-mysql nil nil nil 54 | '(("MYSQL_DATABASE") 55 | ("MYSQL_USER" :user) 56 | ("MYSQL_PASSWORD" :password) 57 | ("MYSQL_HOST" :host) 58 | ("MYSQL_PORT" :port))) 59 | 60 | (emacsql-tests-add-connection-factory 'emacsql-psql nil nil nil 61 | '(("PSQL_DATABASE") 62 | ("PSQL_USER" :username) 63 | ("PSQL_HOST" :hostname) 64 | ("PSQL_PORT" :port))) 65 | 66 | (message " ! skip `emacsql-pg' connector; known to be broken") 67 | ;; FIXME Fix broken `emacsql-pg'. 68 | ;; (emacsql-tests-add-connection-factory 'emacsql-pg 'pg "28.1" nil 69 | ;; '(("PG_DATABASE") 70 | ;; ("PG_USER") 71 | ;; ("PG_PASSWORD" :password) 72 | ;; ("PG_HOST" :host) 73 | ;; ("PG_PORT" :port))) 74 | ) 75 | 76 | (ert-deftest emacsql-basic () 77 | "A short test that fully interacts with SQLite." 78 | (let ((emacsql-global-timeout emacsql-tests-timeout)) 79 | (dolist (factory emacsql-tests-connection-factories) 80 | (emacsql-with-connection (db (funcall factory)) 81 | (emacsql db [:create-temporary-table foo ([x])]) 82 | (should-error (emacsql db [:create-temporary-table foo ([x])])) 83 | (emacsql db [:insert :into foo :values ([1] [2] [3])]) 84 | (should (equal (emacsql db [:select * :from foo]) 85 | '((1) (2) (3)))))))) 86 | 87 | (ert-deftest emacsql-nul-character () 88 | "Try inserting and retrieving strings with a NUL byte." 89 | (let ((emacsql-global-timeout emacsql-tests-timeout)) 90 | (dolist (factory emacsql-tests-connection-factories) 91 | (emacsql-with-connection (db (funcall factory)) 92 | (emacsql db [:create-temporary-table foo ([x])]) 93 | (emacsql db [:insert :into foo :values (["a\0bc"])]) 94 | (should (equal (emacsql db [:select * :from foo]) 95 | '(("a\0bc")))))))) 96 | 97 | (ert-deftest emacsql-foreign-key () 98 | "Tests that foreign keys work properly through EmacSQL." 99 | (let ((emacsql-global-timeout emacsql-tests-timeout)) 100 | (dolist (factory emacsql-tests-connection-factories) 101 | (emacsql-with-connection (db (funcall factory)) 102 | (unwind-protect 103 | (progn 104 | (emacsql-thread db 105 | [:create-table person ([(id integer :primary-key) name])] 106 | [:create-table likes 107 | ([(personid integer) color] 108 | (:foreign-key [personid] :references person [id] 109 | :on-delete :cascade))] 110 | [:insert :into person :values ([0 "Chris"] [1 "Brian"])]) 111 | (should (equal (emacsql db [:select * :from person :order-by id]) 112 | '((0 "Chris") (1 "Brian")))) 113 | (emacsql db [:insert :into likes 114 | :values ([0 red] [0 yellow] [1 yellow])]) 115 | (should (equal (emacsql db [:select * :from likes 116 | :order-by [personid color]]) 117 | '((0 red) (0 yellow) (1 yellow)))) 118 | (emacsql db [:delete :from person :where (= id 0)]) 119 | (should (equal (emacsql db [:select * :from likes]) 120 | '((1 yellow))))) 121 | (emacsql-thread db 122 | [:drop-table likes] 123 | [:drop-table person])))))) 124 | 125 | (ert-deftest emacsql-error () 126 | "Check that we're getting expected conditions." 127 | (should-error (emacsql-compile nil [:insert :into foo :values 1]) 128 | :type 'emacsql-syntax) 129 | (let ((emacsql-global-timeout emacsql-tests-timeout)) 130 | (dolist (factory emacsql-tests-connection-factories) 131 | (emacsql-with-connection (db (funcall factory)) 132 | (emacsql db [:create-temporary-table foo ([x])]) 133 | (should-error (emacsql db [:create-temporary-table foo ([x])]) 134 | :type 'emacsql-error))))) 135 | 136 | (ert-deftest emacsql-special-chars () 137 | "A short test that interacts with SQLite with special characters." 138 | (let ((emacsql-global-timeout 4)) 139 | (dolist (factory emacsql-tests-connection-factories) 140 | (emacsql-with-connection (db (funcall factory)) 141 | (emacsql db [:create-temporary-table test-table ([x])]) 142 | (emacsql db [:insert-into test-table :values ([""] [\])]) 143 | (when (cl-typep db 'process) 144 | (should (emacsql-live-p db))) 145 | (should (equal (emacsql db [:select * :from test-table]) 146 | '(("") (\)))))))) 147 | 148 | ;;; emacsql-external-tests.el ends here 149 | --------------------------------------------------------------------------------