;;; lsp-mode.el --- Minor mode for interacting with Language Servers -*- lexical-binding: t -*-

;; Copyright (C) 2016-2018  Vibhav Pant <vibhavp@gmail.com>

;; 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 <http://www.gnu.org/licenses/>.

;; Author: Vibhav Pant <vibhavp@gmail.com>
;; URL: https://github.com/emacs-lsp/lsp-mode
;; Package-Requires: ((emacs "25.1"))
;; Version: 4.2

;;; Commentary:

;;; Code:

(require 'lsp-methods)
(require 'lsp-io)
(require 'cl-lib)
(require 'network-stream)

(defvar lsp-version-support "3.0"
  "This is the version of the Language Server Protocol currently supported by ‘lsp-mode’.")

;;;###autoload
(define-minor-mode lsp-mode ""
  nil nil nil
  :lighter (:eval (lsp-mode-line))
  :group 'lsp-mode)

(defun lsp--make-stdio-connection (name command command-fn stderr)
  (lambda (filter sentinel)
    (let* ((command (if command-fn (funcall command-fn) command))
           (final-command (if (consp command) command (list command))))
      (unless (executable-find (nth 0 final-command))
        (error (format "Couldn't find executable %s" (nth 0 final-command))))
      (let ((proc (make-process
                    :name name
                    :connection-type 'pipe
                    :coding 'no-conversion
                    :command final-command
                    :filter filter
                    :sentinel sentinel
                    :stderr stderr
                    :noquery t)))
        ;; TODO: This is redundant with :noquery above, but due to a
        ;; bug pre-Emacs 26 it is still needed
        ;; https://debbugs.gnu.org/cgi/bugreport.cgi?bug=30031
        (set-process-query-on-exit-flag (get-buffer-process (get-buffer stderr)) nil)
        proc))))

(defun lsp--make-tcp-connection (name command command-fn host port stderr)
  (lambda (filter sentinel)
    (let* ((command (if command-fn (funcall command-fn) command))
            (final-command (if (consp command) command (list command)))
            proc tcp-proc)
      (unless (executable-find (nth 0 final-command))
        (error (format "Couldn't find executable %s" (nth 0 final-command))))
      (setq proc (make-process
                   :name name
                   :connection-type 'pipe
                   :coding 'no-conversion
                   :command final-command
                   :sentinel sentinel
                   :stderr stderr
                   :noquery t)
        tcp-proc (open-network-stream (concat name " TCP connection")
                   nil host port
                   :type 'plain))
      ;; TODO: Same :noquery issue (see above)
      (set-process-query-on-exit-flag (get-buffer-process (get-buffer stderr)) nil)
      (set-process-query-on-exit-flag tcp-proc nil)
      (set-process-filter tcp-proc filter)
      (cons proc tcp-proc))))

(cl-defmacro lsp-define-whitelist-add (name get-root
                                               &key docstring)
  "Define a function to add the project root for the current buffer to the whitleist.
NAME is the base name for the command.
GET-ROOT is the language-specific function to determine the project root for the current buffer."
  (let ((whitelist-add      (intern (format "%s-whitelist-add" name)))
        (enable-interactive (intern (format "%s-enable" name))))
    `(defun ,whitelist-add ()
       ,docstring
       (interactive)
       (let ((root (funcall ,get-root)))
         (customize-save-variable 'lsp-project-whitelist
           (add-to-list 'lsp-project-whitelist (lsp--as-regex root)))
         (,enable-interactive)))))

(cl-defmacro lsp-define-whitelist-remove (name get-root
                                            &key docstring)
  "Define a function to remove the project root for the current buffer from the whitleist.
NAME is the base name for the command.
GET-ROOT is the language-specific function to determine the project root for the current buffer."
  (let ((whitelist-remove (intern (format "%s-whitelist-remove" name))))
    `(defun ,whitelist-remove ()
       ,docstring
       (interactive)
       (let ((root (funcall ,get-root)))
         (customize-save-variable 'lsp-project-whitelist
           (remove (lsp--as-regex root) lsp-project-whitelist))))))

(defun lsp--as-regex (root)
  "Convert the directory path in ROOT to an equivalent regex."
  (concat "^" (regexp-quote root) "$"))

(cl-defmacro lsp-define-stdio-client (name language-id get-root command
                                       &key docstring
                                       language-id-fn
                                       command-fn
                                       ignore-regexps
                                       ignore-messages
                                       extra-init-params
                                       initialize
                                       prefix-function)
  "Define a LSP client using stdio.
NAME is the symbol to use for the name of the client.
LANGUAGE-ID is the language id to be used when communication with
the Language Server.  COMMAND is the command to run.

Optional arguments:
`:docstring' is an optional docstring used for the entrypoint function created by
`lsp-define-stdio-client'.

`:ignore-regexps' is a list of regexps.  When a data packet from the LSP server
 matches any of these regexps, it will be ignored.  This is intended for dealing
 with LSP servers that output non-protocol data.

`:ignore-messages' is a list of regexps.  When a message from the LSP server
 matches any of these regexps, it will be ignored.  This is useful for filtering
 out unwanted messages; such as servers that send nonstandard message types, or
 extraneous `logMessage's.

`:command-fn' is a function that returns the command string/list to be used to
 launch the language server. If non-nil, COMMAND is ignored.

`:language-id-fn' is a function that returns the language-id string to be used
 while opening a new file. If non-nil, LANGUAGE-ID is ignored.

`:extra-init-params' is a plist that specifies any (optional)
 initializeOptions parameters required by the LSP server. A function taking
 a single argument (LSP workspace) and returning a plist is also accepted.

`:initialize' is a function called when the client is initialized. It takes a
 single argument, the newly created client.

`:prefix-function' is a function called for getting the prefix for completion.
 The function takes no parameter and returns a cons (start . end) representing
 the start and end bounds of the prefix. If it's not set, the client uses a
 default prefix function."
  (cl-check-type name symbol)
  (let ((enable-name (intern (format "%s-enable" name))))
    `(progn
       (lsp-define-whitelist-add ,name ,get-root)
       (lsp-define-whitelist-remove ,name ,get-root)
       (defun ,enable-name ()
         ,docstring
         (interactive)
         (lsp--enable-stdio-client ',name
           :language-id ,language-id
           :language-id-fn ,language-id-fn
           :root-directory-fn ,get-root
           :command ,command
           :command-fn ,command-fn
           :ignore-regexps ,ignore-regexps
           :ignore-messages ,ignore-messages
           :extra-init-params ,extra-init-params
           :initialize-fn ,initialize
           :enable-function (function ,enable-name)
           :prefix-function ,prefix-function)))))

(cl-defun lsp--enable-stdio-client (name &key language-id language-id-fn
                                         root-directory-fn command command-fn
                                         ignore-regexps ignore-messages
                                         extra-init-params initialize-fn
                                         enable-function
                                         prefix-function)
  (cl-check-type name symbol)
  (cl-check-type language-id (or null string))
  (cl-check-type language-id-fn (or null function))
  (cl-check-type root-directory-fn (or null function))
  (cl-check-type command list)
  (cl-check-type command-fn (or null function))
  (cl-check-type ignore-regexps list)
  (cl-check-type ignore-messages list)
  (cl-check-type extra-init-params (or list function))
  (cl-check-type initialize-fn (or null function))
  ;; (cl-check-type enable-function function)
  (cl-check-type prefix-function (or null function))
  (when (and (not lsp-mode) (buffer-file-name))
    (let* ((stderr (generate-new-buffer-name
                    (concat "*" (symbol-name name) " stderr*")))
           (client (make-lsp--client
                    :language-id (or language-id-fn (lambda (_) language-id))
                    :new-connection (lsp--make-stdio-connection
                                     (symbol-name name)
                                     command
                                     command-fn
                                     stderr)
                    :stderr stderr
                    :get-root root-directory-fn
                    :ignore-regexps ignore-regexps
                    :ignore-messages ignore-messages
                    :enable-function enable-function
                    :prefix-function prefix-function)))
      (when initialize-fn
        (funcall initialize-fn client))
      (let ((root (funcall (lsp--client-get-root client))))
        (if (lsp--should-start-p root)
            (lsp--start client extra-init-params)
          (message "Not initializing project %s" root))))))

(cl-defmacro lsp-define-tcp-client (name language-id get-root command host port
                                     &key docstring
                                     language-id-fn
                                     command-fn
                                     ignore-regexps
                                     ignore-messages
                                     extra-init-params
                                     initialize
                                     prefix-function)
  "Define a LSP client using TCP.
NAME is the symbol to use for the name of the client.
LANGUAGE-ID is the language id to be used when communication with
the Language Server.  COMMAND is the command to run.  HOST is the
host address.  PORT is the port number.

Optional arguments:
`:ignore-regexps' is a list of regexps.  When a data packet from the LSP server
 matches any of these regexps, it will be ignored.  This is intended for dealing
 with LSP servers that output non-protocol data.

`:ignore-messages' is a list of regexps.  When a message from the LSP server
 matches any of these regexps, it will be ignored.  This is useful for filtering
 out unwanted messages; such as servers that send nonstandard message types, or
 extraneous `logMessage's.

`:command-fn' is a function that returns the command string/list to be used to
 launch the language server. If non-nil, COMMAND is ignored.

`:language-id-fn' is a function that returns the language-id string to be used
 while opening a new file. If non-nil, LANGUAGE-ID is ignored.

`:extra-init-params' is a plist that specifies any (optional)
 initializeOptions parameters required by the LSP server. A function taking
 a single argument (LSP workspace) and returning a plist is also accepted.

`:initialize' is a function called when the client is initialized. It takes a
  single argument, the newly created client.

`:prefix-function' is a function called for getting the prefix for completion.
 The function takes no parameter and returns a cons (start . end) representing
 the start and end bounds of the prefix. If it's not set, the client uses a
 default prefix function."
  (cl-check-type name symbol)
  (let ((enable-name (intern (format "%s-enable" name))))
    `(progn
       (lsp-define-whitelist-add ,name ,get-root)
       (lsp-define-whitelist-remove ,name ,get-root)
       (defun ,enable-name ()
         ,docstring
         (interactive)
         (lsp--enable-tcp-client ',name
           :language-id ,language-id
           :language-id-fn ,language-id-fn
           :root-directory-fn ,get-root
           :command ,command
           :command-fn ,command-fn
           :host ,host
           :port ,port
           :ignore-regexps ,ignore-regexps
           :ignore-messages ,ignore-messages
           :extra-init-params ,extra-init-params
           :initialize-fn ,initialize
           :enable-function (function ,enable-name)
           :prefix-function ,prefix-function)))))

(cl-defun lsp--enable-tcp-client (name &key language-id language-id-fn
                                       root-directory-fn command command-fn
                                       host port
                                       ignore-regexps ignore-messages
                                       extra-init-params initialize-fn
                                       enable-function
                                       prefix-function)
  (cl-check-type name symbol)
  (cl-check-type language-id (or null string))
  (cl-check-type language-id-fn (or null function))
  (cl-check-type root-directory-fn (or null function))
  (cl-check-type command list)
  (cl-check-type command-fn (or null function))
  (cl-check-type host string)
  (cl-check-type port (integer 1 #xFFFF))
  (cl-check-type ignore-regexps list)
  (cl-check-type ignore-messages list)
  (cl-check-type extra-init-params (or list function))
  (cl-check-type initialize-fn (or null function))
  (cl-check-type prefix-function (or null function))
  (when (and (not lsp-mode) (buffer-file-name))
    (let* ((stderr (generate-new-buffer-name
                    (concat "*" (symbol-name name) " stderr*")))
           (client (make-lsp--client
                    :language-id (or language-id-fn (lambda (_) language-id))
                    :new-connection (lsp--make-tcp-connection
                                     (symbol-name name)
                                     command
                                     command-fn
                                     host port
                                     stderr)
                    :stderr stderr
                    :get-root root-directory-fn
                    :ignore-regexps ignore-regexps
                    :ignore-messages ignore-messages
                    :enable-function enable-function
                    :prefix-function prefix-function)))
      (when initialize-fn
        (funcall initialize-fn client))
      (let ((root (funcall (lsp--client-get-root client))))
        (if (lsp--should-start-p root)
            (lsp--start client extra-init-params)
          (message "Not initializing project %s" root))))))

(defvar-local lsp-status nil
  "The current status of the LSP server.")

(defun lsp-workspace-status (status-string &optional workspace)
  "Set current workspace status to STATUS-STRING.
If WORKSPACE is not specified defaults to lsp--cur-workspace."
  (setf (lsp--workspace-status (or workspace lsp--cur-workspace)) status-string))

(defun lsp-mode-line ()
  "Construct the mode line text."
  (concat " LSP" lsp-status (lsp--workspace-status lsp--cur-workspace)))

(defconst lsp--sync-type
  `((0 . "None")
    (1 . "Full Document")
    (2 . "Incremental Changes")))

(defconst lsp--capabilities
  `(("textDocumentSync" . ("Document sync method" .
                           ((0 . "None")
                            (1 . "Send full contents")
                            (2 . "Send incremental changes."))))
    ("hoverProvider" . ("The server provides hover support" . boolean))
    ("completionProvider" . ("The server provides completion support" . boolean))
    ("signatureHelpProvider" . ("The server provides signature help support" . boolean))
    ("definitionProvider" . ("The server provides goto definition support" . boolean))
    ("typeDefinitionProvider" . ("The server provides goto type definition support" . boolean))
    ("implementationProvider" . ("The server provides goto implementation support" . boolean))
    ("referencesProvider" . ("The server provides references support" . boolean))
    (("documentHighlightProvider" . ("The server provides document highlight support." . boolean)))
    ("documentSymbolProvider" . ("The server provides file symbol support" . boolean))
    ("workspaceSymbolProvider" . ("The server provides project symbol support" . boolean))
    ("codeActionProvider" . ("The server provides code actions" . boolean))
    ("codeLensProvider" . ("The server provides code lens" . boolean))
    ("documentFormattingProvider" . ("The server provides file formatting" . boolean))
    ("documentOnTypeFormattingProvider" . ("The server provides on-type formatting" . boolean))
    ("documentLinkProvider" . ("The server provides document link support" . boolean))
    ("executeCommandProvider" . ("The server provides command execution support" . boolean))
    (("documentRangeFormattingProvider" . ("The server provides region formatting" . boolean)))
    (("renameProvider" . ("The server provides rename support" . boolean)))))

(defun lsp--cap-str (cap)
  (let* ((elem (assoc cap lsp--capabilities))
         (desc (cadr elem))
         (type (cddr elem))
         (value (gethash cap (lsp--server-capabilities))))
    (when (and elem desc type value)
      (concat desc (cond
                    ((listp type) (concat ": " (cdr (assoc value type))))) "\n"))))

(defun lsp-capabilities ()
  "View all capabilities for the language server associated with this buffer."
  (interactive)
  (unless lsp--cur-workspace
    (user-error "No language server is associated with this buffer"))
  (let ((str (mapconcat #'lsp--cap-str (reverse (hash-table-keys
                                                 (lsp--server-capabilities))) ""))
        (buffer-name (generate-new-buffer-name "lsp-capabilities"))
        )
    (get-buffer-create buffer-name)
    (with-current-buffer buffer-name
      (view-mode -1)
      (erase-buffer)
      (insert str)
      (view-mode 1))
    (switch-to-buffer buffer-name)))

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