emacs eglot for sqls

eglot-sqls.el

;; <--------------------------------------------------
;; # SQL

(require 'sql)

;; <-------------------------
;; ## eglot

(defclass eglot-sqls (eglot-lsp-server) ())
(add-to-list 'eglot-server-programs '(sql-mode . (eglot-sqls "sqls")))

;; <----------
;; ### Code actions

(keymap-set sql-mode-map "C-c c" #'my/sqls/switch-connections)
(keymap-set sql-mode-map "C-c d" #'my/sqls/switch-database)
(keymap-set sql-mode-map "C-c t" #'my/sqls/show-tables)
(keymap-set sql-mode-map "C-c e" #'my/sqls/execute-query)

(defun my/sqls/switch-connections ()
  (interactive)
  (eglot-execute
   (eglot--current-server-or-lose)
   `(:command "switchConnections")))

(defun my/sqls/switch-database ()
  (interactive)
  (eglot-execute
   (eglot--current-server-or-lose)
   `(:command "switchDatabase")))

(defun my/sqls/show-tables ()
  (interactive)
  (eglot-execute
   (eglot--current-server-or-lose)
   `(:command "showTables")))

(defun my/sqls/execute-query ()
  (interactive)
  (eglot-execute
   (eglot--current-server-or-lose)
   `(:command
     "executeQuery"
     :arguments
     ,(vector (format "file://%s" buffer-file-name)))))

;; >----------

(defvar my/sqls/state (make-hash-table :test #'equal))

(defun my/sqls/state/key (key)
  (let* ((server (eglot-current-server))
         (project (and server (eglot-project-nickname server)))
         (project (or project "-"))
         (key (format "%s%s" project key)))
    key))

(defun my/sqls/state/get (key)
  (gethash
   (my/sqls/state/key key)
   my/sqls/state))

(defun my/sqls/state/set (key value)
  (puthash
   (my/sqls/state/key key)
   value
   my/sqls/state))

(cl-defmethod eglot-execute
  :around
  ((server eglot-sqls) action)

  (pcase (plist-get action :command)
    ("executeQuery"
     (if (use-region-p)
         (let* ((begin (region-beginning))
                (end (region-end))
                (begin-lsp (eglot--pos-to-lsp-position begin))
                (end-lsp (eglot--pos-to-lsp-position end))
                (action (plist-put action :range `(:start ,begin-lsp :end ,end-lsp)))
                (result (cl-call-next-method server action)))
           (my/sqls/show-result/query result))
       (message "No region")))

    ((or
      "showConnections"
      "showDatabases"
      "showSchemas"
      "showTables")
     (my/sqls/show-result (cl-call-next-method)))

    ("switchConnections"
     (let* ((connections (eglot--request server :workspace/executeCommand
                                         '(:command "showConnections")))
            (collection (split-string connections "\n"))
            (connection (completing-read "Switch to connection: " collection nil t))
            (index (number-to-string (string-to-number connection)))
            (action (plist-put action :arguments (vector index))))
       (cl-call-next-method server action)
       (my/sqls/state/set :current-connection connection)
       (my/sqls/state/set :current-database nil)
       (my/sqls/show-result "Connection switched")))

    ("switchDatabase"
     (let* ((databases (eglot--request server :workspace/executeCommand
                                       '(:command "showDatabases")))
            (collection (split-string databases "\n"))
            (database (completing-read "Switch to database: " collection nil t))
            (action (plist-put action :arguments (vector database))))
       (cl-call-next-method server action)
       (my/sqls/state/set :current-database database)
       (my/sqls/show-result "Database switched")))

    (_
     (cl-call-next-method))))

(defun my/sqls/show-result (result)
  (let* ((server (eglot-current-server))
         (project (and server (eglot-project-nickname server)))
         (name (format "*sqls result* %s" project))
         (header (my/sqls/show-result/header-line-format)))
    (with-current-buffer (get-buffer-create name)
      (erase-buffer)
      (unless (derived-mode-p 'org-mode)
        (org-mode))
      (insert result)
      (display-buffer (current-buffer))
      (setq header-line-format header))))

(defun my/sqls/show-result/query (result)
  (let ((result
         (if (string-prefix-p "+-" result)
             (let* ((result (substring result (1+ (s-index-of "\n" result))))
                    (result (replace-regexp-in-string "^\\+-" "|-" result))
                    (result (replace-regexp-in-string "-\\+$" "-|" result)))
               result)
           result)))
    (my/sqls/show-result result)))

(defun my/sqls/show-result/header-line-format ()
  (let* ((connection (or (my/sqls/state/get :current-connection) ""))
         (database (my/sqls/state/get :current-database))
         (parts (split-string connection " "))
         (driver (nth 1 parts))
         (alias (nth 2 parts))
         (result (format "[%s] %s/%s"
                         (or driver "-")
                         (or alias "-")
                         (or database "-"))))
    (propertize result
                'face 'modus-themes-heading-0)))
;; >-------------------------

;; <-------------------------
;; ## flymake

;; $ gem install sqlint
;; $ ln -s /usr/local/lib/ruby/gems/3.3.0/bin/sqlint /usr/local/bin

;; $ brew install sql-lint

(add-hook 'sql-mode-hook #'my/sql/flymake-hook)

(defun my/sql/flymake-hook ()
  (add-hook 'flymake-diagnostic-functions #'flymake-collection-sqlint nil t)
  (add-hook 'flymake-diagnostic-functions #'flymake-collection-sql-lint nil t)
  (flymake-mode)
  (setq-local eglot-stay-out-of '(flymake))
  (add-hook 'flymake-diagnostic-functions #'eglot-flymake-backend nil t))

;; mysql postgres
(setopt flymake-collection-sql-lint-driver "postgres")
;; >-------------------------
;; >--------------------------------------------------