;;; lsp-mssql.el --- MSSQL LSP bindings              -*- lexical-binding: t; -*-

;; Copyright (C) 2019  Ivan Yonchovski
;; Copyright (C) 2019-2026  emacs-lsp maintainers
;; Package-Version: 20260507.1743
;; Package-Revision: 02e50306c92a

;; Author: Ivan Yonchovski <yyoncho@gmail.com>
;; Keywords: data, languages
;; Package-Requires: ((emacs "29.1") (lsp-mode "6.2") (dash "2.14.1") (f "0.20.0") (ht "2.0") (lsp-treemacs "0.1"))
;; URL: https://github.com/emacs-lsp/lsp-mssql

;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program.  If not, see <https://www.gnu.org/licenses/>.

;;; Commentary:
;; lsp-mode client for MSSQL language server.

;;; Code:

(require 'lsp-mode)
(require 'lsp-treemacs)
(require 'gnutls)

(defgroup lsp-mssql nil
  "LSP support for the MSSQL server."
  :link '(url-link "https://github.com/microsoft/sqltoolsservice")
  :group 'lsp-mode)

(defcustom  lsp-mssql-download-location
  (expand-file-name "mssql/" user-emacs-directory)
  "Server download location."
  :type 'directory)

(defcustom lsp-mssql-default-batch-size 10
  "Default number of items to load per query."
  :type 'number)

(defconst lsp-mssql-server-download-url
  "https://download.microsoft.com/download/c/2/f/c9857f58-e569-4677-ad24-f180e83a8252/microsoft.sqltools.servicelayer-%s")

(defconst lsp-mssql-executable-files
  '("MicrosoftSqlToolsServiceLayer.exe" "MicrosoftSqlToolsServiceLayer" "MicrosoftSqlToolsServiceLayer.dll"))

(declare-function org-mode "ext:org" ())
(declare-function org-show-all "ext:org" (types))
(declare-function org-table-align "ext:org-table" ())

(defvar lsp-mssql--connection-name->session-id (ht))

(defvar-local lsp-mssql-buffer-status nil
  "SQL buffer status.")

(defvar-local lsp-mssql-result-metadata nil
  "Metadata associated with result set.

This is stored in the result buffer as buffer local value.")

(put 'lsp-mssql-buffer-status 'risky-local-variable t)
(add-to-list 'global-mode-string (list '(t lsp-mssql-buffer-status)))

(defun lsp-mssql--extract (filename target-dir)
  "Extracts FILENAME into TARGET-DIR."
  (cond
   ((eq system-type 'windows-nt)
    ;; on windows, we attempt to use powershell v5+, available on Windows 10+
    (let ((powershell-version (substring
                               (shell-command-to-string "powershell -command \"(Get-Host).Version.Major\"")
                               0 -1)))
      (if (>= (string-to-number powershell-version) 5)
          (call-process "powershell"
                        nil
                        nil
                        nil
                        "-command"
                        (concat "add-type -assembly system.io.compression.filesystem;"
                                "[io.compression.zipfile]::ExtractToDirectory(\"" filename "\", \"" target-dir "\")"))

        (message (concat "lsp-csharp: for automatic server installation procedure"
                         " to work on Windows you need to have powershell v5+ installed")))))

   ((or (eq system-type 'gnu/linux)
        (eq system-type 'darwin))
    (call-process "tar" nil nil t "xf" filename "-C" target-dir))

   (t (error "MSSQL server cannot extract \"%s\" on platform %s (yet)" filename system-type))))

(defun lsp-mssql--download (url filename)
  "Downloads file from URL as FILENAME.
Will not do anything should the file exist already."
  (let ((gnutls-algorithm-priority
         (if (and (not gnutls-algorithm-priority)
                  (boundp 'libgnutls-version)
                  (>= libgnutls-version 30603)
                  (version<= emacs-version "26.2"))
             "NORMAL:-VERS-TLS1.3"
           gnutls-algorithm-priority)))
    (url-copy-file url filename t)))


(defun lsp-mssql-download-server ()
  "Download mssql server.
Uses `powershell' on windows and `tar' on Linux to extract the server binary."
  (interactive)
  (let* ((result (cond ((eq system-type 'darwin)  "osx-x64-netcoreapp2.2.tar.gz")
                       ((eq system-type 'gnu/linux)  "rhel-x64-netcoreapp2.2.tar.gz")
                       ((eq system-type 'windows-nt) "win-x64-netcoreapp2.2.zip")
                       (t (error (format "Unsupported system: %s" system-type)))))
         (download-location (f-join temporary-file-directory result))
         (url (format lsp-mssql-server-download-url result)))
    (lsp--info "Starting downloading mssql server in %s from %s." download-location url)
    (lsp-mssql--download url download-location)
    (mkdir lsp-mssql-download-location t)
    (lsp-mssql--extract download-location lsp-mssql-download-location)

    (seq-doseq (file lsp-mssql-executable-files)
      (let ((target-file (f-join lsp-mssql-download-location file)))
        (when (f-exists? target-file)
          (chmod target-file #o755)))))
  (lsp--info "Downloading mssql server finished."))

(defun lsp-mssql--expand-completed (workspace params)
  "Expand completed handler.
WORKSPACE is the active workspace.
PARAMS expand completed params."
  (-let [(&hash "nodePath" node-path "nodes") params]
    (puthash (cons node-path nil)
             (append nodes nil)
             (gethash "explorer" (lsp--workspace-metadata workspace)) )
    (lsp-mssql-object-explorer)))

(defun lsp-mssql--session-created (workspace params)
  "Session created handler.
WORKSPACE is the active workspace.
PARAMS Session created handler."
  (-let [(&hash "rootNode" root-node "sessionId" session-id) params]
    (puthash (cons session-id t)
             (list root-node)
             (gethash "explorer" (lsp--workspace-metadata workspace)) )
    (lsp-mssql-object-explorer)))

(defcustom lsp-mssql-log-debug-info nil
  "[Optional] Log debug output to the VS Code console (Help -> Toggle Developer Tools)."
  :type 'boolean)

(define-widget 'lsp-connection-vector 'lazy
  "Connection vector."
  :offset 4
  :tag "Connections Vector"
  :type '(restricted-sexp
          :match-alternatives (lambda (candidate)
                                (and
                                 (vectorp candidate)
                                 (seq-every-p #'listp candidate)))))

(defcustom lsp-mssql-connections ['(:server "{{put-server-name-here}}"
                                            :database  "{{put-database-name-here}}"
                                            :user  "{{put-username-here}}"
                                            :password  "{{put-password-here}}")]
  "Connection profiles defined in 'User Settings' are shown under 'MS SQL: Connect' command in the command palette."
  :type 'lsp-connection-vector)

(defcustom lsp-mssql-intelli-sense-enable-intelli-sense t
  "Should IntelliSense be enabled."
  :type 'boolean)

(defcustom lsp-mssql-intelli-sense-enable-error-checking t
  "Should IntelliSense error checking be enabled."
  :type 'boolean)

(defcustom lsp-mssql-intelli-sense-enable-suggestions t
  "Should IntelliSense suggestions be enabled."
  :type 'boolean)

(defcustom lsp-mssql-intelli-sense-enable-quick-info t
  "Should IntelliSense quick info be enabled."
  :type 'boolean)

(defcustom lsp-mssql-intelli-sense-lower-case-suggestions t
  "Should IntelliSense suggestions be lowercase."
  :type 'boolean)

(lsp-register-custom-settings
 '(("mssql.intelliSense.lowerCaseSuggestions" lsp-mssql-intelli-sense-lower-case-suggestions t)
   ("mssql.intelliSense.enableQuickInfo" lsp-mssql-intelli-sense-enable-quick-info t)
   ("mssql.intelliSense.enableSuggestions" lsp-mssql-intelli-sense-enable-suggestions t)
   ("mssql.intelliSense.enableErrorChecking" lsp-mssql-intelli-sense-enable-error-checking t)
   ("mssql.intelliSense.enableIntelliSense" lsp-mssql-intelli-sense-enable-intelli-sense t)
   ("mssql.connections" lsp-mssql-connections)
   ("mssql.logDebugInfo" lsp-mssql-log-debug-info t)))

(defmacro lsp-mssql-with-result-buffer (&rest body)
  "Evaluate BODY in result buffer."
  (declare (debug (body)))
  `(with-current-buffer (get-buffer-create "*SQL Results*")
     (prog1 (save-excursion
              (let ((inhibit-read-only t))
                ,@body))
       (org-show-all '(headings blocks)))))

(defun lsp-mssql--connection-complete (_workspace params)
  "Connection completed handler.
PARAMS connection completed params."
  ;; (setq params my/params)
  (if (gethash "connectionId" params)

      (-let [(&hash "ownerUri" owner
                    "connectionSummary" (&hash "serverName" server-name  "databaseName" database-name)) params]
        (lsp--info "Successfully connected to %s, database: %s" server-name database-name)
        (when-let (buffer (find-buffer-visiting (lsp--uri-to-path owner)))
          (with-current-buffer buffer
            (setq lsp-mssql-buffer-status (propertize (format "database::%s:%s" server-name database-name)
                                                      'face 'success)))))
    (-let [(&hash "errorMessage" error-message
                  "errorNumber" error-number) params]
      (lsp--error "Failed to connect with the following error error number: %s\n%s" error-number error-message))))

(defun lsp-mssql--result-set-available (_workspace _params)
  "Result set available handler.")

(defun lsp-mssql--message (_workspace params)
  "Message handler.
PARAMS the params."
  (-let [(&hash "message" (&hash "message" "time" "isError" is-error)) params]
    (funcall (if is-error 'lsp--error 'lsp--info) (format "%s %s" time message))))

(defun lsp-mssql--result-set-updated (_workspace _params)
  "Result set update handler.")

(defun lsp-mssql--render-table (result)
  "Render RESULT as a table."
  (->> result
       (gethash "resultSubset")
       (gethash "rows")
       (seq-map (lambda (item)
                  (->> item
                       (seq-map (-lambda ((&hash "displayValue"))
                                  (concat "|" displayValue)))
                       (apply #'concat))))
       (s-join "|\n")))

(defun lsp-mssql--replace-overlay-text (ov string)
  "Replace text inside overlay OV with STRING."
  (let ((start (overlay-start ov)))
    (save-excursion
      ;; This is a bit silly, but this way we don't have to make new
      ;; buttons, we just replace the text inside an exisiting button.
      ;; We can't insert at the start of the overlay because that
      ;; would only push the existing one away, not inserting the new
      ;; text into it.
      (goto-char (1+ start))
      (insert string)
      (delete-region (point) (overlay-end ov))
      (goto-char (1+ start))
      (delete-char -1))))

(defvar lsp-mssql-after-render-table-hook nil
  "Hook called after data is rendered in the result buffer.

When the hook is called, the point is at the end of the buffer.")

(defun lsp-mssql--result-set-complete (workspace params)
  "Result set complete handler.
WORKSPACE is the active workspace.
PARAMS the params."
  (-let* ((column-info (gethash "columnInfo" (gethash "resultSetSummary" params)))
          (result-metadata (seq-map (-lambda ((&hash "columnName" name "dataTypeName" type))
                                      (list name :name name :type type))
                                    column-info))
          (marker (lsp-mssql-with-result-buffer
                   (setq-local lsp-mssql-result-metadata result-metadata)
                   (goto-char (point-max))
                   (insert (format "|%s|\n"(s-join "|" (seq-map (-lambda ((&hash "columnName" name))
                                                                  name)
                                                                column-info))))
                   (insert "|-")
                   (org-table-align)
                   (goto-char (point-at-eol))
                   (copy-marker (point))))
          ((&hash "ownerUri" owner-uri
                  "resultSetSummary"(&hash "rowCount" row-count "batchId" "id")) params)
          (loaded-index 0)
          (to-load lsp-mssql-default-batch-size)
          more-items-marker)
    (cl-labels ((subset-params
                 ()
                 (if (< loaded-index row-count)
                     (let ((to-load (if (> (+ loaded-index to-load) row-count)
                                        (- row-count loaded-index)
                                      to-load)))
                       `(:ownerUri ,owner-uri
                         :resultSetIndex ,id
                         :rowsCount ,to-load
                         :rowsStartIndex ,(prog1 loaded-index
                                            (setf loaded-index (+ loaded-index to-load)))
                         :batchIndex ,batchId))
                   (lsp--info "All items are loaded")
                   nil))
                (render-load-more
                 ()
                 (if (= loaded-index row-count)
                     (progn
                       (when (looking-at-p "^Load")
                         (delete-region (line-beginning-position) (line-end-position)))
                       (insert "|-")
                       (org-table-align)
                       (end-of-line))
                   (if (looking-at-p "^Load")
                       (lsp-mssql--replace-overlay-text
                        (car (overlays-at (point)))
                        (format "Load %s more... (%s/%s)" to-load loaded-index row-count))
                     (insert (format "Load %s more... (%s/%s)" to-load loaded-index row-count))))))
      (when-let ((params (subset-params)))
        (with-lsp-workspace workspace
          (lsp-request-async
           "query/subset"
           params
           (lambda (result)
             (lsp-mssql-with-result-buffer
              (goto-char (marker-position marker))
              (insert "\n")
              (insert (lsp-mssql--render-table result))
              (setq more-items-marker (copy-marker (point)))
              (insert "\n")
              (let ((start (point)))
                (render-load-more)
                (make-button
                 start (point)
                 'action (lambda (&rest _)
                           (interactive)
                           (when-let ((params (subset-params)))
                             (with-lsp-workspace workspace
                               (lsp-request-async
                                "query/subset"
                                params
                                (lambda (result)
                                  (lsp-mssql-with-result-buffer
                                   (goto-char (1- (marker-position more-items-marker)))
                                   (insert "\n")
                                   (insert (lsp-mssql--render-table result))
                                   (org-table-align)
                                   (forward-line 1)
                                   (render-load-more)
                                   (run-hooks 'lsp-mssql-after-render-table-hook)))
                                :mode 'detached))))
                 'keymap (-doto (make-sparse-keymap)
                           (define-key [M-return] 'push-button)
                           (define-key [mouse-2] 'push-button))
                 'help-echo "mouse-2, M-RET: Load more items."))
              (insert "\n\n")
              (goto-char (marker-position marker))
              (org-table-align)
              (display-buffer (current-buffer))
              (run-hooks 'lsp-mssql-after-render-table-hook)))
           :mode 'detached))))))

(defun lsp-mssql--batch-complete (_workspace _params)
  "Hanler for batch complete.")

(defun lsp-mssql--complete (_workspace _params)
  "Hanler for complete."
  (lsp-mssql-with-result-buffer))

(defvar-local lsp-mssql--markers (ht))

(defun lsp-mssql--batch-start (_workspace params)
  "Batch start handler.
PARAMS batch handler params."
  (lsp-mssql-with-result-buffer
   (-let [(&hash "batchSummary" (&hash "executionStart" execution-start
                                       ;; "selection" (&hash "startColumn"
                                       ;;                    "startLine"
                                       ;;                    "endLine"
                                       ;;                    "endColumn")
                                       ;; "id"
                                       )
                 ;; "ownerUri" owner-uri
                 ) params]
     ;; (insert (format "* Batch %s\n" id))
     (lsp--info "%s Started execution" execution-start)
     ;; (insert "#+BEGIN_SRC sql\n")
     ;; (insert (with-current-buffer (find-buffer-visiting (lsp--uri-to-path owner-uri))
     ;;           (buffer-substring (lsp--position-to-point (ht ("line" startLine)
     ;;                                                         ("character" startColumn)))
     ;;                             (lsp--position-to-point (ht ("line" endLine)
     ;;                                                         ("character" endColumn))))))
     ;; (insert "#+END_SRC\n\n")
     )
   (display-buffer (current-buffer))))

(defun lsp-mssql--connection-changed (_workspace _params)
  "Hanler for batch complete.")

(defun lsp-mssql--after-open-fn ()
  "After open handler."
  (setq lsp-mssql-buffer-status (propertize "SQL Server disconnected"
                                            'face 'warning
                                            'local-map (make-mode-line-mouse-map
                                                        'mouse-1 'lsp-mssql-connect))))
(lsp-register-client
 (make-lsp-client :new-connection
                  (lsp-stdio-connection
                   (lambda ()
                     (let ((server (f-join lsp-mssql-download-location "MicrosoftSqlToolsServiceLayer")))
                       (if (executable-find server)
                           (list server)
                         (if (y-or-n-p "The mssql server is not present. Do you want to download it? ")
                             (progn
                               (lsp-mssql-download-server)
                               (list server))
                           (user-error "Server is not installed? "))))))
                  :major-modes '(sql-mode)
                  :priority -1
                  :multi-root t
                  :notification-handlers (ht ("objectexplorer/expandCompleted" #'lsp-mssql--expand-completed)
                                             ("objectexplorer/sessioncreated" 'lsp-mssql--session-created)
                                             ("connection/complete" #'lsp-mssql--connection-complete)
                                             ("connection/connectionchanged" 'lsp-mssql--connection-changed)
                                             ("telemetry/sqlevent" 'ignore)
                                             ("textDocument/intelliSenseReady" 'ignore)
                                             ("query/resultSetAvailable" 'lsp-mssql--result-set-available)
                                             ("query/message" 'lsp-mssql--message)
                                             ("query/resultSetUpdated" 'lsp-mssql--result-set-updated)
                                             ("query/resultSetComplete" 'lsp-mssql--result-set-complete)
                                             ("query/batchComplete"  'lsp-mssql--batch-complete)
                                             ("query/batchStart"  'lsp-mssql--batch-start)
                                             ("query/complete" 'lsp-mssql--complete))
                  :server-id 'sql
                  :initialized-fn (lambda (workspace)
                                    (ht-clear lsp-mssql--connection-name->session-id)
                                    (puthash "explorer" (ht) (lsp--workspace-metadata workspace))
                                    (with-lsp-workspace workspace
                                      (lsp--set-configuration (lsp-configuration-section "mssql"))))
                  :after-open-fn #'lsp-mssql--after-open-fn))

(defun lsp-mssql-connect (connection)
  "Connect current buffer to a server using CONNECTION spec."
  (interactive (list (lsp--completing-read
                      "Select connection: "
                      (append lsp-mssql-connections nil)
                      (lambda (connection)
                        (plist-get connection :server))
                      nil
                      t)))
  (lsp-request "connection/connect"
               `(:ownerUri ,(lsp--buffer-uri)
                           :connection (:options ,connection))))

(defun lsp-mssql-disconnect ()
  "Disconnect buffer from sql server."
  (interactive)
  (lsp-request "connection/disconnect" `(:ownerUri ,(lsp--buffer-uri)))
  (lsp-mssql--after-open-fn))

(defun lsp-mssql-execute-region (start end)
  "Execute selected region START to END."
  (interactive "r")
  (lsp-mssql-with-result-buffer
   (read-only-mode -1)
   (org-mode)
   (erase-buffer)
   (read-only-mode 1))
  (-let (((&plist :line start-line
                  :character start-character) (lsp--point-to-position start))
         ((&plist :line end-line
                  :character end-character) (lsp--point-to-position end)))
    (lsp-request
     "query/executeDocumentSelection"
     (list :ownerUri (lsp--buffer-uri)
           :querySelection (list :startLine start-line
                                 :startColumn start-character
                                 :endLine end-line
                                 :endColumn end-character)))))

(defun lsp-mssql-execute-buffer ()
  "Execute the SQL code in the buffer."
  (interactive)
  (lsp-mssql-with-result-buffer
   (read-only-mode -1)
   (org-mode)
   (erase-buffer)
   (read-only-mode 1))
  (lsp-request "query/executeDocumentSelection" (list :ownerUri (lsp--buffer-uri))))

(defun lsp-mssql-cancel ()
  "Cancel the current query."
  (interactive)
  (lsp-request "query/cancel" (list :ownerUri (lsp--buffer-uri))))


;; object explorer

(treemacs-modify-theme "Default"
  :icon-directory (f-join (f-dirname (or load-file-name buffer-file-name)) "images")
  :config
  (progn
    (treemacs-create-icon :file "AggregateFunction.png" :extensions (AggregateFunction) :fallback "-")
    (treemacs-create-icon :file "AggregateFunctionParameter_Input.png" :extensions (AggregateFunctionParameter_Input) :fallback "-")
    (treemacs-create-icon :file "AggregateFunctionParameter_Output.png" :extensions (AggregateFunctionParameter_Output) :fallback "-")
    (treemacs-create-icon :file "AggregateFunctionParameter_Return.png" :extensions (AggregateFunctionParameter_Return) :fallback "-")
    (treemacs-create-icon :file "ApplicationRole.png" :extensions (ApplicationRole) :fallback "-")
    (treemacs-create-icon :file "Assembly.png" :extensions (Assembly) :fallback "-")
    (treemacs-create-icon :file "AsymmetricKey.png" :extensions (AsymmetricKey) :fallback "-")
    (treemacs-create-icon :file "BrokerPriority.png" :extensions (BrokerPriority) :fallback "-")
    (treemacs-create-icon :file "Certificate.png" :extensions (Certificate) :fallback "-")
    (treemacs-create-icon :file "Column.png" :extensions (Column) :fallback "-")
    (treemacs-create-icon :file "ColumnEncryptionKey.png" :extensions (ColumnEncryptionKey) :fallback "-")
    (treemacs-create-icon :file "ColumnMasterKey.png" :extensions (ColumnMasterKey) :fallback "-")
    (treemacs-create-icon :file "Constraint.png" :extensions (Constraint) :fallback "-")
    (treemacs-create-icon :file "Contract.png" :extensions (Contract) :fallback "-")
    (treemacs-create-icon :file "Database.png" :extensions (Database) :fallback "-")
    (treemacs-create-icon :file "DatabaseAndQueueEventNotification.png" :extensions (DatabaseAndQueueEventNotification) :fallback "-")
    (treemacs-create-icon :file "DatabaseAuditSpecification.png" :extensions (DatabaseAuditSpecification) :fallback "-")
    (treemacs-create-icon :file "DatabaseEncryptionKey.png" :extensions (DatabaseEncryptionKey) :fallback "-")
    (treemacs-create-icon :file "DatabaseRole.png" :extensions (DatabaseRole) :fallback "-")
    (treemacs-create-icon :file "DatabaseScopedCredential.png" :extensions (DatabaseScopedCredential) :fallback "-")
    (treemacs-create-icon :file "DatabaseTrigger.png" :extensions (DatabaseTrigger) :fallback "-")
    (treemacs-create-icon :file "Database_Unavailable.png" :extensions (Database_Unavailable) :fallback "-")
    (treemacs-create-icon :file "DefaultIcon.png" :extensions (DefaultIcon) :fallback "-")
    (treemacs-create-icon :file "ExternalDataSource.png" :extensions (ExternalDataSource) :fallback "-")
    (treemacs-create-icon :file "ExternalFileFormat.png" :extensions (ExternalFileFormat) :fallback "-")
    (treemacs-create-icon :file "FileGroupFile.png" :extensions (FileGroupFile) :fallback "-")
    (treemacs-create-icon :file "Folder.png" :extensions (Folder) :fallback "-")
    (treemacs-create-icon :file "FullTextCatalog.png" :extensions (FullTextCatalog) :fallback "-")
    (treemacs-create-icon :file "FullTextStopList.png" :extensions (FullTextStopList) :fallback "-")
    (treemacs-create-icon :file "HDFSFolder.png" :extensions (HDFSFolder) :fallback "-")
    (treemacs-create-icon :file "Index.png" :extensions (Index) :fallback "-")
    (treemacs-create-icon :file "Key_ForeignKey.png" :extensions (Key_ForeignKey) :fallback "-")
    (treemacs-create-icon :file "Key_PrimaryKey.png" :extensions (Key_PrimaryKey) :fallback "-")
    (treemacs-create-icon :file "Key_UniqueKey.png" :extensions (Key_UniqueKey) :fallback "-")
    (treemacs-create-icon :file "MasterKey.png" :extensions (MasterKey) :fallback "-")
    (treemacs-create-icon :file "MessageType.png" :extensions (MessageType) :fallback "-")
    (treemacs-create-icon :file "PartitionFunction.png" :extensions (PartitionFunction) :fallback "-")
    (treemacs-create-icon :file "PartitionScheme.png" :extensions (PartitionScheme) :fallback "-")
    (treemacs-create-icon :file "Queue.png" :extensions (Queue) :fallback "-")
    (treemacs-create-icon :file "RemoteServiceBinding.png" :extensions (RemoteServiceBinding) :fallback "-")
    (treemacs-create-icon :file "Route.png" :extensions (Route) :fallback "-")
    (treemacs-create-icon :file "ScalarValuedFunction.png" :extensions (ScalarValuedFunction) :fallback "-")
    (treemacs-create-icon :file "ScalarValuedFunctionParameter_Input.png" :extensions (ScalarValuedFunctionParameter_Input) :fallback "-")
    (treemacs-create-icon :file "ScalarValuedFunctionParameter_Output.png" :extensions (ScalarValuedFunctionParameter_Output) :fallback "-")
    (treemacs-create-icon :file "ScalarValuedFunctionParameter_Return.png" :extensions (ScalarValuedFunctionParameter_Return) :fallback "-")
    (treemacs-create-icon :file "Schema.png" :extensions (Schema) :fallback "-")
    (treemacs-create-icon :file "SearchPropertyList.png" :extensions (SearchPropertyList) :fallback "-")
    (treemacs-create-icon :file "SecurityPolicy.png" :extensions (SecurityPolicy) :fallback "-")
    (treemacs-create-icon :file "Sequence.png" :extensions (Sequence) :fallback "-")
    (treemacs-create-icon :file "ServerLevelCredential.png" :extensions (ServerLevelCredential) :fallback "-")
    (treemacs-create-icon :file "ServerLevelCryptographicProvider.png" :extensions (ServerLevelCryptographicProvider) :fallback "-")
    (treemacs-create-icon :file "ServerLevelEndpoint.png" :extensions (ServerLevelEndpoint) :fallback "-")
    (treemacs-create-icon :file "ServerLevelLinkedServer.png" :extensions (ServerLevelLinkedServer) :fallback "-")
    (treemacs-create-icon :file "ServerLevelLinkedServerLogin.png" :extensions (ServerLevelLinkedServerLogin) :fallback "-")
    (treemacs-create-icon :file "ServerLevelLinkedServerLogin_Disabled.png" :extensions (ServerLevelLinkedServerLogin_Disabled) :fallback "-")
    (treemacs-create-icon :file "ServerLevelLogin.png" :extensions (ServerLevelLogin) :fallback "-")
    (treemacs-create-icon :file "ServerLevelLogin_Disabled.png" :extensions (ServerLevelLogin_Disabled) :fallback "-")
    (treemacs-create-icon :file "ServerLevelServerAudit.png" :extensions (ServerLevelServerAudit) :fallback "-")
    (treemacs-create-icon :file "ServerLevelServerAuditSpecification.png" :extensions (ServerLevelServerAuditSpecification) :fallback "-")
    (treemacs-create-icon :file "ServerLevelServerRole.png" :extensions (ServerLevelServerRole) :fallback "-")
    (treemacs-create-icon :file "ServerLevelServerTrigger.png" :extensions (ServerLevelServerTrigger) :fallback "-")
    (treemacs-create-icon :file "Server_green.png" :extensions (Server) :fallback "-")
    (treemacs-create-icon :file "Server_red.png" :extensions (Server_red) :fallback "-")
    (treemacs-create-icon :file "Service.png" :extensions (Service) :fallback "-")
    (treemacs-create-icon :file "SqlLogFile.png" :extensions (SqlLogFile) :fallback "-")
    (treemacs-create-icon :file "Statistic.png" :extensions (Statistic) :fallback "-")
    (treemacs-create-icon :file "StoredProcedure.png" :extensions (StoredProcedure) :fallback "-")
    (treemacs-create-icon :file "StoredProcedureParameter_Input.png" :extensions (StoredProcedureParameter_Input) :fallback "-")
    (treemacs-create-icon :file "StoredProcedureParameter_Output.png" :extensions (StoredProcedureParameter_Output) :fallback "-")
    (treemacs-create-icon :file "StoredProcedureParameter_Return.png" :extensions (StoredProcedureParameter_Return) :fallback "-")
    (treemacs-create-icon :file "SymmetricKey.png" :extensions (SymmetricKey) :fallback "-")
    (treemacs-create-icon :file "Synonym.png" :extensions (Synonym) :fallback "-")
    (treemacs-create-icon :file "SystemApproximateNumeric.png" :extensions (SystemApproximateNumeric) :fallback "-")
    (treemacs-create-icon :file "SystemBinaryString.png" :extensions (SystemBinaryString) :fallback "-")
    (treemacs-create-icon :file "SystemCharacterString.png" :extensions (SystemCharacterString) :fallback "-")
    (treemacs-create-icon :file "SystemClrDataType.png" :extensions (SystemClrDataType) :fallback "-")
    (treemacs-create-icon :file "SystemContract.png" :extensions (SystemContract) :fallback "-")
    (treemacs-create-icon :file "SystemDateAndTime.png" :extensions (SystemDateAndTime) :fallback "-")
    (treemacs-create-icon :file "SystemExactNumeric.png" :extensions (SystemExactNumeric) :fallback "-")
    (treemacs-create-icon :file "SystemMessageType.png" :extensions (SystemMessageType) :fallback "-")
    (treemacs-create-icon :file "SystemOtherDataType.png" :extensions (SystemOtherDataType) :fallback "-")
    (treemacs-create-icon :file "SystemQueue.png" :extensions (SystemQueue) :fallback "-")
    (treemacs-create-icon :file "SystemService.png" :extensions (SystemService) :fallback "-")
    (treemacs-create-icon :file "SystemSpatialDataType.png" :extensions (SystemSpatialDataType) :fallback "-")
    (treemacs-create-icon :file "SystemUnicodeCharacterString.png" :extensions (SystemUnicodeCharacterString) :fallback "-")
    (treemacs-create-icon :file "Table.png" :extensions (Table) :fallback "-")
    (treemacs-create-icon :file "TableValuedFunction.png" :extensions (TableValuedFunction) :fallback "-")
    (treemacs-create-icon :file "TableValuedFunctionParameter_Input.png" :extensions (TableValuedFunctionParameter_Input) :fallback "-")
    (treemacs-create-icon :file "TableValuedFunctionParameter_Output.png" :extensions (TableValuedFunctionParameter_Output) :fallback "-")
    (treemacs-create-icon :file "TableValuedFunctionParameter_Return.png" :extensions (TableValuedFunctionParameter_Return) :fallback "-")
    (treemacs-create-icon :file "Table_Temporal.png" :extensions (Table_Temporal) :fallback "-")
    (treemacs-create-icon :file "Trigger.png" :extensions (Trigger) :fallback "-")
    (treemacs-create-icon :file "Trigger_Disabled.png" :extensions (Trigger_Disabled) :fallback "-")
    (treemacs-create-icon :file "User.png" :extensions (User) :fallback "-")
    (treemacs-create-icon :file "UserDefinedDataType.png" :extensions (UserDefinedDataType) :fallback "-")
    (treemacs-create-icon :file "UserDefinedTableType.png" :extensions (UserDefinedTableType) :fallback "-")
    (treemacs-create-icon :file "UserDefinedTableTypeColumn.png" :extensions (UserDefinedTableTypeColumn) :fallback "-")
    (treemacs-create-icon :file "UserDefinedTableTypeConstraint.png" :extensions (UserDefinedTableTypeConstraint) :fallback "-")
    (treemacs-create-icon :file "UserDefinedType.png" :extensions (UserDefinedType) :fallback "-")
    (treemacs-create-icon :file "User_Disabled.png" :extensions (User_Disabled) :fallback "-")
    (treemacs-create-icon :file "View.png" :extensions (View) :fallback "-")
    (treemacs-create-icon :file "XmlSchemaCollection.png" :extensions (XmlSchemaCollection) :fallback "-")
    (treemacs-create-icon :file "add.png" :extensions (add) :fallback "-")
    (treemacs-create-icon :file "add_inverse.png" :extensions (add_inverse) :fallback "-")))

(defvar lsp-mssql-object-explorer-map
  (-doto (make-sparse-keymap)
    (define-key (kbd "R")  #'lsp-mssql-object-explorer-refresh)
    (define-key (kbd "C")  #'lsp-mssql-object-explorer-connect)
    (define-key (kbd "K")  #'lsp-mssql-object-explorer-disconnect))
  "Keymap for `lsp-mssql-object-explorer-mode'.")

(define-minor-mode lsp-mssql-object-explorer-mode
  "Minor mode for SQL Object Explorer."
  nil nil lsp-mssql-object-explorer-map)

(defun lsp-mssql-object-explorer-disconnect ()
  "Disconnect placeholder."
  (interactive)
  (user-error "To be implemented? "))

(defun lsp-mssql-object-explorer-refresh ()
  "Refresh object explorer."
  (interactive)
  (-let [(&plist :session-id :node-path) (button-get (treemacs-node-at-point) :item)]
    (with-lsp-workspace (lsp-find-workspace 'sql)
                        (lsp-request "objectexplorer/refresh"
                                     `(:sessionId ,session-id :nodePath ,node-path)))))

(defun lsp-mssql--to-node (nodes &optional session-id node)
  "Convert NODE to lsp-treemacs generic node.
SESSION-ID - the session id.
NODES - all nodes."
  (setq session-id (or session-id (gethash "sessionId" node)))

  (-let [(&hash "label" "nodeType" node-type "nodePath" node-path "isLeaf" leaf?) node]
    `(:label ,label
             :key ,label
             :icon ,(intern node-type)
             :node-path ,node-path
             :session-id ,session-id
             :actions ,(if (string= node-type "Server")
                           '(["Refresh" lsp-mssql-object-explorer-refresh]
                             ["Disconnect" lsp-mssql-object-explorer-disconnect])
                         '(["Refresh" lsp-mssql-object-explorer-refresh]))
             ,@(unless leaf?
                 (list :children
                       (lambda (_node)
                         (let ((children (gethash (list node-path) nodes :empty)))
                           (if (not (eq :empty children))
                               (-map (-partial #'lsp-mssql--to-node nodes session-id) children)
                             (with-lsp-workspace (lsp-find-workspace 'sql nil)
                               (lsp-request "objectexplorer/expand"
                                            `(:sessionId ,session-id :nodePath ,node-path))
                               nil)))))))))

(defun lsp-mssql--show-explorer (tree title)
  "Show explorer.
TREE is the data to display, TITLE will be used for the
modeline in the result buffer."
  (with-current-buffer (get-buffer-create "*SQL Object explorer*")
    (lsp-treemacs-initialize)
    (setq-local lsp-treemacs-tree tree)
    (setq-local face-remapping-alist '((button . default)))
    (lsp-treemacs-generic-refresh)
    (display-buffer-in-side-window (current-buffer) '((side . right)))
    (setq-local mode-name title)
    (lsp-mssql-object-explorer-mode)))



(defun lsp-mssql-object-explorer-connect (&rest _)
  "Open connection."
  (interactive)
  (-let [(connection &as &plist :server :user) (plist-get (button-get (treemacs-node-at-point) :item) :connection)]
    (with-lsp-workspace (lsp-find-workspace 'sql)
      (puthash
       (concat server " : " user)
       (gethash "sessionId"
                (lsp-request "objectexplorer/createsession"
                             (list :options connection)))
       lsp-mssql--connection-name->session-id))))

(defun lsp-mssql-object-explorer ()
  "Show server explorer."
  (interactive)
  (lsp-mssql--show-explorer
   (append
    (let ((all-nodes (-some->> (lsp-find-workspace 'sql nil)
                       lsp--workspace-metadata
                       (gethash "explorer"))))
      (->> all-nodes
           (ht->alist)
           (-keep (-lambda (((id . is-session?) . (node)))
                    (when is-session?
                      (lsp-mssql--to-node all-nodes id node))))))
    (->> lsp-mssql-connections
         (seq-map
          (-lambda ((connection &as &plist :server :user))
            (let ((connection-name (concat server " : " user)))
              (unless (gethash connection-name
                               lsp-mssql--connection-name->session-id)
                `(:label ,connection-name
                         :icon Server_red
                         :key ,connection-name
                         :connection ,connection
                         :actions (["Connect" lsp-mssql-object-explorer-connect]))))))
         (seq-filter #'identity)))
   "*MSSQL Object Explorer*"))



(provide 'lsp-mssql)
;;; lsp-mssql.el ends here
