emacsql.el (15910B)
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 <wellons@nullprogram.com> 6 ;; URL: https://github.com/skeeto/emacsql 7 ;; Version: 3.0.0 8 ;; Package-Requires: ((emacs "25.1")) 9 10 ;;; Commentary: 11 12 ;; EmacSQL is a high-level Emacs Lisp front-end for SQLite 13 ;; (primarily), PostgreSQL, MySQL, and potentially other SQL 14 ;; databases. On MELPA, each of the backends is provided through 15 ;; separate packages: emacsql-sqlite, emacsql-psql, emacsql-mysql. 16 17 ;; Most EmacSQL functions operate on a database connection. For 18 ;; example, a connection to SQLite is established with 19 ;; `emacsql-sqlite'. For each such connection a sqlite3 inferior 20 ;; process is kept alive in the background. Connections are closed 21 ;; with `emacsql-close'. 22 23 ;; (defvar db (emacsql-sqlite "company.db")) 24 25 ;; Use `emacsql' to send an s-expression SQL statements to a connected 26 ;; database. Identifiers for tables and columns are symbols. SQL 27 ;; keywords are lisp keywords. Anything else is data. 28 29 ;; (emacsql db [:create-table people ([name id salary])]) 30 31 ;; Column constraints can optionally be provided in the schema. 32 33 ;; (emacsql db [:create-table people ([name (id integer :unique) salary])]) 34 35 ;; Insert some values. 36 37 ;; (emacsql db [:insert :into people 38 ;; :values (["Jeff" 1000 60000.0] ["Susan" 1001 64000.0])]) 39 40 ;; Currently all actions are synchronous and Emacs will block until 41 ;; SQLite has indicated it is finished processing the last command. 42 43 ;; Query the database for results: 44 45 ;; (emacsql db [:select [name id] :from employees :where (> salary 60000)]) 46 ;; ;; => (("Susan" 1001)) 47 48 ;; Queries can be templates -- $i1, $s2, etc. -- so they don't need to 49 ;; be built up dynamically: 50 51 ;; (emacsql db 52 ;; [:select [name id] :from employees :where (> salary $s1)] 53 ;; 50000) 54 ;; ;; => (("Jeff" 1000) ("Susan" 1001)) 55 56 ;; The letter declares the type (identifier, scalar, vector, Schema) 57 ;; and the number declares the argument position. 58 59 ;; See README.md for much more complete documentation. 60 61 ;;; Code: 62 63 (require 'cl-lib) 64 (require 'cl-generic) 65 (require 'eieio) 66 (require 'emacsql-compiler) 67 68 (defgroup emacsql nil 69 "The EmacSQL SQL database front-end." 70 :group 'comm) 71 72 (defvar emacsql-version "3.0.0") 73 74 (defvar emacsql-global-timeout 30 75 "Maximum number of seconds to wait before bailing out on a SQL command. 76 If nil, wait forever.") 77 78 (defvar emacsql-data-root 79 (file-name-directory (or load-file-name buffer-file-name)) 80 "Directory where EmacSQL is installed.") 81 82 ;;; Database connection 83 84 (defclass emacsql-connection () 85 ((process :type process 86 :initarg :process 87 :accessor emacsql-process) 88 (log-buffer :type (or null buffer) 89 :initarg :log-buffer 90 :initform nil 91 :accessor emacsql-log-buffer 92 :documentation "Output log (debug).") 93 (finalizer :documentation "Object returned from `make-finalizer'.") 94 (types :allocation :class 95 :initform nil 96 :reader emacsql-types 97 :documentation "Maps EmacSQL types to SQL types.")) 98 (:documentation "A connection to a SQL database.") 99 :abstract t) 100 101 (cl-defgeneric emacsql-close (connection) 102 "Close CONNECTION and free all resources.") 103 104 (cl-defgeneric emacsql-reconnect (connection) 105 "Re-establish CONNECTION with the same parameters.") 106 107 (cl-defmethod emacsql-live-p ((connection emacsql-connection)) 108 "Return non-nil if CONNECTION is still alive and ready." 109 (not (null (process-live-p (emacsql-process connection))))) 110 111 (cl-defgeneric emacsql-types (connection) 112 "Return an alist mapping EmacSQL types to database types. 113 This will mask `emacsql-type-map' during expression compilation. 114 This alist should have four key symbols: integer, float, object, 115 nil (default type). The values are strings to be inserted into a 116 SQL expression.") 117 118 (cl-defmethod emacsql-buffer ((connection emacsql-connection)) 119 "Get process buffer for CONNECTION." 120 (process-buffer (emacsql-process connection))) 121 122 (cl-defmethod emacsql-enable-debugging ((connection emacsql-connection)) 123 "Enable debugging on CONNECTION." 124 (unless (buffer-live-p (emacsql-log-buffer connection)) 125 (setf (emacsql-log-buffer connection) 126 (generate-new-buffer " *emacsql-log*")))) 127 128 (cl-defmethod emacsql-log ((connection emacsql-connection) message) 129 "Log MESSAGE into CONNECTION's log. 130 MESSAGE should not have a newline on the end." 131 (let ((log (emacsql-log-buffer connection))) 132 (when log 133 (with-current-buffer log 134 (setf (point) (point-max)) 135 (princ (concat message "\n") log))))) 136 137 ;;; Sending and receiving 138 139 (cl-defgeneric emacsql-send-message ((connection emacsql-connection) message) 140 "Send MESSAGE to CONNECTION.") 141 142 (cl-defmethod emacsql-send-message :before 143 ((connection emacsql-connection) message) 144 (emacsql-log connection message)) 145 146 (cl-defmethod emacsql-clear ((connection emacsql-connection)) 147 "Clear the process buffer for CONNECTION-SPEC." 148 (with-current-buffer (emacsql-buffer connection) 149 (erase-buffer))) 150 151 (cl-defgeneric emacsql-waiting-p (connection) 152 "Return non-nil if CONNECTION is ready for more input.") 153 154 (cl-defmethod emacsql-wait ((connection emacsql-connection) &optional timeout) 155 "Block until CONNECTION is waiting for further input." 156 (let* ((real-timeout (or timeout emacsql-global-timeout)) 157 (end (when real-timeout (+ (float-time) real-timeout)))) 158 (while (and (or (null real-timeout) (< (float-time) end)) 159 (not (emacsql-waiting-p connection))) 160 (save-match-data 161 (accept-process-output (emacsql-process connection) real-timeout))) 162 (unless (emacsql-waiting-p connection) 163 (signal 'emacsql-timeout (list "Query timed out" real-timeout))))) 164 165 (cl-defgeneric emacsql-parse (connection) 166 "Return the results of parsing the latest output or signal an error.") 167 168 (defun emacsql-compile (connection sql &rest args) 169 "Compile s-expression SQL for CONNECTION into a string." 170 (let* ((mask (when connection (emacsql-types connection))) 171 (emacsql-type-map (or mask emacsql-type-map))) 172 (concat (apply #'emacsql-format (emacsql-prepare sql) args) ";"))) 173 174 (cl-defmethod emacsql ((connection emacsql-connection) sql &rest args) 175 "Send SQL s-expression to CONNECTION and return the results." 176 (let ((sql-string (apply #'emacsql-compile connection sql args))) 177 (emacsql-clear connection) 178 (emacsql-send-message connection sql-string) 179 (emacsql-wait connection) 180 (emacsql-parse connection))) 181 182 ;;; Helper mixin class 183 184 (defclass emacsql-protocol-mixin () 185 () 186 (:documentation 187 "A mixin for back-ends following the EmacSQL protocol. 188 The back-end prompt must be a single \"]\" character. This prompt 189 value was chosen because it is unreadable. Output must have 190 exactly one row per line, fields separated by whitespace. NULL 191 must display as \"nil\".") 192 :abstract t) 193 194 (cl-defmethod emacsql-waiting-p ((connection emacsql-protocol-mixin)) 195 "Return true if the end of the buffer has a properly-formatted prompt." 196 (with-current-buffer (emacsql-buffer connection) 197 (and (>= (buffer-size) 2) 198 (string= "#\n" (buffer-substring (- (point-max) 2) (point-max)))))) 199 200 (cl-defmethod emacsql-handle ((_ emacsql-protocol-mixin) code message) 201 "Signal a specific condition for CODE from CONNECTION. 202 Subclasses should override this method in order to provide more 203 specific error conditions." 204 (signal 'emacsql-error (list code message))) 205 206 (cl-defmethod emacsql-parse ((connection emacsql-protocol-mixin)) 207 "Parse well-formed output into an s-expression." 208 (with-current-buffer (emacsql-buffer connection) 209 (setf (point) (point-min)) 210 (let* ((standard-input (current-buffer)) 211 (value (read))) 212 (if (eql value 'error) 213 (emacsql-handle connection (read) (read)) 214 (prog1 value 215 (unless (eq 'success (read)) 216 (emacsql-handle connection (read) (read)))))))) 217 218 (provide 'emacsql) ; end of generic function declarations 219 220 ;;; Automatic connection cleanup 221 222 (defun emacsql-register (connection) 223 "Register CONNECTION for automatic cleanup and return CONNECTION." 224 (let ((finalizer (make-finalizer (lambda () (emacsql-close connection))))) 225 (prog1 connection 226 (setf (slot-value connection 'finalizer) finalizer)))) 227 228 ;;; Useful macros 229 230 (defmacro emacsql-with-connection (connection-spec &rest body) 231 "Open an EmacSQL connection, evaluate BODY, and close the connection. 232 CONNECTION-SPEC establishes a single binding. 233 234 (emacsql-with-connection (db (emacsql-sqlite \"company.db\")) 235 (emacsql db [:create-table foo [x]]) 236 (emacsql db [:insert :into foo :values ([1] [2] [3])]) 237 (emacsql db [:select * :from foo]))" 238 (declare (indent 1)) 239 `(let ((,(car connection-spec) ,(cadr connection-spec))) 240 (unwind-protect 241 (progn ,@body) 242 (emacsql-close ,(car connection-spec))))) 243 244 (defvar emacsql--transaction-level 0 245 "Keeps track of nested transactions in `emacsql-with-transaction'.") 246 247 (defmacro emacsql-with-transaction (connection &rest body) 248 "Evaluate BODY inside a single transaction, issuing a rollback on error. 249 This macro can be nested indefinitely, wrapping everything in a 250 single transaction at the lowest level. 251 252 Warning: BODY should *not* have any side effects besides making 253 changes to the database behind CONNECTION. Body may be evaluated 254 multiple times before the changes are committed." 255 (declare (indent 1)) 256 `(let ((emacsql--connection ,connection) 257 (emacsql--completed nil) 258 (emacsql--transaction-level (1+ emacsql--transaction-level)) 259 (emacsql--result)) 260 (unwind-protect 261 (while (not emacsql--completed) 262 (condition-case nil 263 (progn 264 (when (= 1 emacsql--transaction-level) 265 (emacsql emacsql--connection [:begin])) 266 (let ((result (progn ,@body))) 267 (setf emacsql--result result) 268 (when (= 1 emacsql--transaction-level) 269 (emacsql emacsql--connection [:commit])) 270 (setf emacsql--completed t))) 271 (emacsql-locked (emacsql emacsql--connection [:rollback]) 272 (sleep-for 0.05)))) 273 (when (and (= 1 emacsql--transaction-level) 274 (not emacsql--completed)) 275 (emacsql emacsql--connection [:rollback]))) 276 emacsql--result)) 277 278 (defmacro emacsql-thread (connection &rest statements) 279 "Thread CONNECTION through STATEMENTS. 280 A statement can be a list, containing a statement with its arguments." 281 (declare (indent 1)) 282 `(let ((emacsql--conn ,connection)) 283 (emacsql-with-transaction emacsql--conn 284 ,@(cl-loop for statement in statements 285 when (vectorp statement) 286 collect (list 'emacsql 'emacsql--conn statement) 287 else 288 collect (append (list 'emacsql 'emacsql--conn) statement))))) 289 290 (defmacro emacsql-with-bind (connection sql-and-args &rest body) 291 "For each result row bind the column names for each returned row. 292 Returns the result of the last evaluated BODY. 293 294 All column names must be provided in the query ($ and * are not 295 allowed). Hint: all of the bound identifiers must be known at 296 compile time. For example, in the expression below the variables 297 'name' and 'phone' will be bound for the body. 298 299 (emacsql-with-bind db [:select [name phone] :from people] 300 (message \"Found %s with %s\" name phone)) 301 302 (emacsql-with-bind db ([:select [name phone] 303 :from people 304 :where (= name $1)] my-name) 305 (message \"Found %s with %s\" name phone)) 306 307 Each column must be a plain symbol, no expressions allowed here." 308 (declare (indent 2)) 309 (let ((sql (if (vectorp sql-and-args) sql-and-args (car sql-and-args))) 310 (args (unless (vectorp sql-and-args) (cdr sql-and-args)))) 311 (cl-assert (eq :select (elt sql 0))) 312 (let ((vars (elt sql 1))) 313 (when (eq '* vars) 314 (error "Must explicitly list columns in `emacsql-with-bind'.")) 315 (cl-assert (cl-every #'symbolp vars)) 316 `(let ((emacsql--results (emacsql ,connection ,sql ,@args)) 317 (emacsql--final nil)) 318 (dolist (emacsql--result emacsql--results emacsql--final) 319 (setf emacsql--final 320 (cl-destructuring-bind ,(cl-coerce vars 'list) emacsql--result 321 ,@body))))))) 322 323 ;;; User interaction functions 324 325 (defvar emacsql-show-buffer-name "*emacsql-show*" 326 "Name of the buffer for displaying intermediate SQL.") 327 328 (defun emacsql--indent () 329 "Indent and wrap the SQL expression in the current buffer." 330 (save-excursion 331 (setf (point) (point-min)) 332 (let ((case-fold-search nil)) 333 (while (search-forward-regexp " [A-Z]+" nil :no-error) 334 (when (> (current-column) (* fill-column 0.8)) 335 (backward-word) 336 (insert "\n ")))))) 337 338 (defun emacsql-show-sql (string) 339 "Fontify and display the SQL expression in STRING." 340 (let ((fontified 341 (with-temp-buffer 342 (insert string) 343 (sql-mode) 344 (with-no-warnings ;; autoloaded by previous line 345 (sql-highlight-sqlite-keywords)) 346 (if (and (fboundp 'font-lock-flush) 347 (fboundp 'font-lock-ensure)) 348 (save-restriction 349 (widen) 350 (font-lock-flush) 351 (font-lock-ensure)) 352 (with-no-warnings 353 (font-lock-fontify-buffer))) 354 (emacsql--indent) 355 (buffer-string)))) 356 (with-current-buffer (get-buffer-create emacsql-show-buffer-name) 357 (if (< (length string) fill-column) 358 (message "%s" fontified) 359 (let ((buffer-read-only nil)) 360 (erase-buffer) 361 (insert fontified)) 362 (special-mode) 363 (visual-line-mode) 364 (pop-to-buffer (current-buffer)))))) 365 366 (defun emacsql-flatten-sql (sql) 367 "Convert a s-expression SQL into a flat string for display." 368 (cl-destructuring-bind (string . vars) (emacsql-prepare sql) 369 (concat 370 (apply #'format string (cl-loop for i in (mapcar #'car vars) 371 collect (intern (format "$%d" (1+ i))))) 372 ";"))) 373 374 ;;;###autoload 375 (defun emacsql-show-last-sql (&optional prefix) 376 "Display the compiled SQL of the s-expression SQL expression before point. 377 A prefix argument causes the SQL to be printed into the current buffer." 378 (interactive "P") 379 (let ((sexp (if (fboundp 'elisp--preceding-sexp) 380 (elisp--preceding-sexp) 381 (with-no-warnings 382 (preceding-sexp))))) 383 (if (emacsql-sql-p sexp) 384 (let ((sql (emacsql-flatten-sql sexp))) 385 (if prefix 386 (insert sql) 387 (emacsql-show-sql sql))) 388 (user-error "Invalid SQL: %S" sexp)))) 389 390 ;;; Fix Emacs' broken vector indentation 391 392 (defun emacsql--inside-vector-p () 393 "Return non-nil if point is inside a vector expression." 394 (let ((start (point))) 395 (save-excursion 396 (beginning-of-defun) 397 (let ((containing-sexp (elt (parse-partial-sexp (point) start) 1))) 398 (when containing-sexp 399 (setf (point) containing-sexp) 400 (looking-at "\\[")))))) 401 402 (defadvice calculate-lisp-indent (around emacsql-vector-indent disable) 403 "Don't indent vectors in `emacs-lisp-mode' like lists." 404 (if (save-excursion (beginning-of-line) (emacsql--inside-vector-p)) 405 (let ((lisp-indent-offset 1)) 406 ad-do-it) 407 ad-do-it)) 408 409 (defun emacsql-fix-vector-indentation () 410 "When called, advise `calculate-lisp-indent' to stop indenting vectors. 411 Once activate, vector contents no longer indent like lists." 412 (interactive) 413 (ad-enable-advice 'calculate-lisp-indent 'around 'emacsql-vector-indent) 414 (ad-activate 'calculate-lisp-indent)) 415 416 ;;; emacsql.el ends here