[nongnu] elpa/emacsql 9a1b4209ba 164/427: Add PostgreSQL front-end.

[ELPA Syncer]

branch: elpa/emacsql
commit 9a1b4209ba967506cc5d91bb63395123807e956d
Author: Christopher Wellons <wellons@nullprogram.com>
Commit: Christopher Wellons <wellons@nullprogram.com>

    Add PostgreSQL front-end.
---
 Makefile          |  2 +-
 emacsql-psql.el   | 77 +++++++++++++++++++++++++++++++++++++++++++++++++++++++
 emacsql-sqlite.el | 10 ++++----
 emacsql-tests.el  |  7 ++---
 emacsql.el        |  7 +++--
 5 files changed, 90 insertions(+), 13 deletions(-)

diff --git a/Makefile b/Makefile
index b6ea2b187b..477486dba3 100644
--- a/Makefile
+++ b/Makefile
@@ -5,7 +5,7 @@ BATCH   := $(EMACS) -batch -Q -L .
 COMPILE := $(BATCH) -f batch-byte-compile
 TEST    := $(BATCH) -l $(PACKAGE)-tests.elc -f ert-run-tests-batch
 
-EL = emacsql.el emacsql-sqlite.el $(PACKAGE)-tests.el
+EL = emacsql.el emacsql-sqlite.el emacsql-psql.el $(PACKAGE)-tests.el
 
 ELC = $(EL:.el=.elc)
 
diff --git a/emacsql-psql.el b/emacsql-psql.el
new file mode 100644
index 0000000000..5dd3184e4a
--- /dev/null
+++ b/emacsql-psql.el
@@ -0,0 +1,77 @@
+;;; emacsql-psql.el --- PostgreSQL front-end for Emacsql -*- lexical-binding: 
t; -*-
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'eieio)
+(require 'emacsql)
+
+(defvar emacsql-psql-executable "psql"
+  "Path to the psql (PostgreSQL client) executable.")
+
+(defclass emacsql-psql-connection (emacsql-connection)
+  ((dbname :reader emacsql-psql-dbname :initarg :dbname))
+  (:documentation "A connection to a PostgreSQL database."))
+
+(cl-defun emacsql-psql (dbname &key username hostname port)
+  "Connect to a PostgreSQL server using the psql command line program."
+  (let ((args (list dbname)))
+    (when username
+      (push username args))
+    (push "-n" args)
+    (when port
+      (push "-p" args)
+      (push port args))
+    (when hostname
+      (push "-h" args)
+      (push hostname args))
+    (setf args (nreverse args))
+    (let* ((buffer (generate-new-buffer "*emacsql-psql*"))
+           (psql emacsql-psql-executable)
+           (process (apply #'start-process "emacsql-psql" buffer psql args))
+           (connection (make-instance 'emacsql-psql-connection
+                                      :process process
+                                      :dbname dbname)))
+      (prog1 connection
+        (emacsql-add-connection connection)
+        (emacsql-send-string connection "\\pset pager off")
+        (emacsql-send-string connection "\\a")
+        (emacsql-send-string connection "\\t")
+        (emacsql-send-string connection "\\f ' '")
+        (emacsql-send-string connection "\\set PROMPT1 ]")
+        (emacsql-send-string connection "EMACSQL;") ; error message flush
+        (emacsql-wait connection)))))
+
+(defmethod emacsql-close ((connection emacsql-psql-connection))
+  (let ((process (emacsql-process connection)))
+    (when (process-live-p process)
+      (process-send-string process "\\q\n"))))
+
+(defmethod emacsql-waiting-p ((connection emacsql-psql-connection))
+  (with-current-buffer (emacsql-buffer connection)
+    (cond ((= (buffer-size) 1) (string= "]" (buffer-string)))
+          ((> (buffer-size) 1) (string= "\n]"
+                                        (buffer-substring
+                                         (- (point-max) 2) (point-max)))))))
+
+(defun emacsql-psql--check-error (connection)
+  "Return non-nil or throw an appropriate error."
+  (with-current-buffer (emacsql-buffer connection)
+    (emacsql-wait connection)
+    (setf (point) (point-min))
+    (prog1 t
+      (when (looking-at "ERROR:")
+        (let ((message (buffer-substring (line-beginning-position)
+                                          (line-end-position))))
+          (emacsql-error "%s" message))))))
+
+(defmethod emacsql ((connection emacsql-psql-connection) sql &rest args)
+  (let ((sql-string (apply #'emacsql-compile sql args)))
+    (emacsql-clear connection)
+    (emacsql-send-string connection sql-string)
+    (emacsql-psql--check-error connection)
+    (emacsql-sqlite--parse connection)))
+
+(provide 'emacsql-psql)
+
+;;; emacsql-psql.el ends here
diff --git a/emacsql-sqlite.el b/emacsql-sqlite.el
index 243cb73113..25e9ca5fbc 100644
--- a/emacsql-sqlite.el
+++ b/emacsql-sqlite.el
@@ -1,4 +1,4 @@
-;; emacsql-sqlite.el --- SQLite backend for Emacsql -*- lexical-binding: t; -*-
+;; emacsql-sqlite.el --- SQLite front-end for Emacsql -*- lexical-binding: t; 
-*-
 
 ;;; Code:
 
@@ -40,9 +40,10 @@ If FILE is nil use an in-memory database.
 
 :debug LOG -- When non-nil, log all SQLite commands to a log
 buffer. This is for debugging purposes."
-  (let* ((buffer (generate-new-buffer "*emacsql-connection*"))
+  (let* ((buffer (generate-new-buffer "*emacsql-sqlite*"))
          (fullfile (if file (expand-file-name file) ":memory:"))
-         (process (start-process "emacsql" buffer emacsql-sqlite3-executable
+         (sqlite3 emacsql-sqlite3-executable)
+         (process (start-process "emacsql-sqlite" buffer sqlite3
                                  "-interactive" fullfile)))
     (setf (process-sentinel process) (lambda (_proc _) (kill-buffer buffer)))
     (process-send-string process ".mode list\n")
@@ -68,7 +69,7 @@ buffer. This is for debugging purposes."
 (defmethod emacsql-close ((connection emacsql-sqlite-connection))
   "Gracefully exits the SQLite subprocess."
   (let ((process (emacsql-process connection)))
-    (when (and process (process-live-p process))
+    (when (process-live-p process)
       (process-send-string process ".exit\n"))))
 
 (defmethod emacsql-waiting-p ((connection emacsql-sqlite-connection))
@@ -153,7 +154,6 @@ buffer. This is for debugging purposes."
           (signal condition (list message)))))))
 
 (defmethod emacsql ((connection emacsql-sqlite-connection) sql &rest args)
-  "Send structured SQL expression to CONNECTION with ARGS."
   (let ((sql-string (apply #'emacsql-compile sql args)))
     (emacsql-clear connection)
     (emacsql-send-string connection sql-string)
diff --git a/emacsql-tests.el b/emacsql-tests.el
index 36d78722ee..32168b1eaa 100644
--- a/emacsql-tests.el
+++ b/emacsql-tests.el
@@ -4,6 +4,7 @@
 
 (require 'ert)
 (require 'emacsql)
+(require 'emacsql-sqlite)
 
 (ert-deftest emacsql-escape-identifier ()
   (should (string= (emacsql-escape-identifier "foo") "foo"))
@@ -190,7 +191,7 @@
 (ert-deftest emacsql-system ()
   "A short test that fully interacts with SQLite."
   (should-not (emacsql-sqlite3-unavailable-p))
-  (emacsql-with-connection (db nil)
+  (emacsql-with-connection (db (emacsql-sqlite nil))
     (emacsql db [:create-table foo [x]])
     (should-error (emacsql db [:create-table foo [x]]))
     (emacsql db [:insert :into foo :values ([1] [2] [3])])
@@ -199,7 +200,7 @@
 
 (ert-deftest emacsql-foreign-system ()
   "Tests that foreign keys work properly through Emacsql."
-  (emacsql-with-connection (db nil)
+  (emacsql-with-connection (db (emacsql-sqlite nil))
     (emacsql-thread db
       [:pragma (= foreign_keys on)]
       [:create-table person [(id integer :primary) name]]
@@ -224,7 +225,7 @@
                 :type 'emacsql-syntax)
   (should-error (emacsql-compile [:insert :into foo :values 1])
                 :type 'emacsql-syntax)
-  (emacsql-with-connection (db nil)
+  (emacsql-with-connection (db (emacsql-sqlite nil))
     (emacsql db [:create-table foo [x]])
     (should-error (emacsql db [:create-table foo [x]])
                   :type 'emacsql-table)))
diff --git a/emacsql.el b/emacsql.el
index c9097c6113..e6e8bf50ef 100644
--- a/emacsql.el
+++ b/emacsql.el
@@ -194,15 +194,14 @@ This collection exists for cleanup purposes.")
 
 (defmacro emacsql-with-connection (connection-spec &rest body)
   "Open an Emacsql connection, evaluate BODY, and close the connection.
-CONNECTION-SPEC is a connection specification like the call to
-`emacsql-connect', establishing a single binding.
+CONNECTION-SPEC establishes a single binding.
 
-  (emacsql-with-connection (db \"company.db\")
+  (emacsql-with-connection (db (emacsql-sqlite \"company.db\"))
     (emacsql db [:create-table foo [x]])
     (emacsql db [:insert :into foo :values ([1] [2] [3])])
     (emacsql db [:select * :from foo]))"
   (declare (indent 1))
-  `(let ((,(car connection-spec) (emacsql-connect ,@(cdr connection-spec))))
+  `(let ((,(car connection-spec) ,(cadr connection-spec)))
      (unwind-protect
          (progn ,@body)
        (emacsql-close ,(car connection-spec)))))