;;; helm-lsp.el --- LSP helm integration             -*- lexical-binding: t; -*-

;; Copyright (C) 2018  Ivan Yonchovski
;; Copyright (C) 2024-2026  emacs-lsp maintainers

;; 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/>.

;; Author: Ivan Yonchovski <yyoncho@gmail.com>
;; Keywords: languages, debug
;; URL: https://github.com/emacs-lsp/helm-lsp
;; Package-Requires: ((emacs "29.1") (dash "2.14.1") (lsp-mode "5.0") (helm "2.0"))
;; Package-Version: 20260507.1749
;; Package-Revision: 056bb16b5f69

;;; Commentary:

;; `helm' for lsp function.

;;; Code:

(require 'helm)
(require 'helm-imenu)
(require 'dash)
(require 'lsp-mode)

(defvar helm-lsp-symbols-request-id nil)
(defvar helm-lsp-symbols-result-p nil)
(defvar helm-lsp-symbols-result nil)

(defgroup helm-lsp nil
  "`helm-lsp' group."
  :group 'lsp-mode
  :tag "Language Server")

(lsp-defun helm-lsp-workspace-symbol-action ((&SymbolInformation :location))
  "Action for helm workspace symbol.
CANDIDATE is the selected item in the helm menu."
  (lsp-goto-location location))

(defface helm-lsp-container-face
  '((t :height 0.8 :inherit shadow))
  "The face used for code lens overlays."
  :group 'helm-lsp)

(defcustom helm-lsp-treemacs-icons t
  "If non-nil, use `lsp-treemacs' icons."
  :group 'helm-lsp
  :type 'boolean)

(defun helm-lsp--extract-file-name (uri)
  "Extract file name from URI."
  (propertize
   (if (string= "jdt" (-> uri url-unhex-string url-generic-parse-url url-type))
       (cl-second (s-match ".*\(\\(.*\\)" uri))
     (f-filename uri))
   'face 'helm-lsp-container-face))

(defun helm-lsp--get-icon (kind)
  "Get the icon by KIND."
  (require 'lsp-treemacs)
  (ht-get (treemacs-theme->gui-icons (treemacs--find-theme lsp-treemacs-theme))
          (lsp-treemacs-symbol-kind->icon kind)))

(defun helm-lsp--workspace-symbol (workspaces name input)
  "Search against WORKSPACES NAME with default INPUT."
  (setq helm-lsp-symbols-result nil)
  (if workspaces
      (with-lsp-workspaces workspaces
        (helm
         :sources
         (helm-build-sync-source
             name
           :candidates (lambda ()
                         (if helm-lsp-symbols-result-p
                             helm-lsp-symbols-result
                           (with-lsp-workspaces workspaces
                             (-let (((request &as &plist :id request-id) ))
                               (setq helm-lsp-symbols-request-id request-id)
                               (lsp-request-async
                                "workspace/symbol"
                                (list :query helm-pattern)
                                (lambda (candidates)
                                  (setq helm-lsp-symbols-request-id nil)
                                  (and helm-alive-p
                                       (let ((helm-lsp-symbols-result-p t))
                                         (setq helm-lsp-symbols-result candidates)
                                         (helm-update))))
                                :mode 'detached
                                :cancel-token :workspace-symbols)
                               helm-lsp-symbols-result))))
           :action 'helm-lsp-workspace-symbol-action
           :volatile t
           :fuzzy-match t
           :match (-const t)
           :keymap helm-map
           :candidate-transformer
           (lambda (candidates)
             (-map
              (-lambda ((candidate &as
                                   &SymbolInformation :container-name? :name :kind :location (&Location :uri)))
                (let ((type (or (alist-get kind lsp-symbol-kinds) "Unknown")))
                  (cons
                   (if (and (featurep 'lsp-treemacs)
                            helm-lsp-treemacs-icons)
                       (concat
                        (or (helm-lsp--get-icon kind)
                            (helm-lsp--get-icon 'fallback))
                        (if (s-blank? container-name?)
                            name
                          (concat name " " (propertize container-name? 'face 'helm-lsp-container-face)))
                        (propertize " · " 'face 'success)
                        (helm-lsp--extract-file-name uri))
                     (concat (if (s-blank? container-name?)
                                 name
                               (concat name " " (propertize container-name? 'face 'helm-lsp-container-face) " -" ))
                             " "
                             (propertize (concat "(" type ")") 'face 'font-lock-type-face)
                             (propertize " · " 'face 'success)
                             (helm-lsp--extract-file-name uri)))
                   candidate)))
              (-take helm-candidate-number-limit candidates)))
           :candidate-number-limit nil
           :requires-pattern 0)
         :input input))
    (user-error "No LSP workspace active")))

;;;###autoload
(defun helm-lsp-workspace-symbol (arg)
  "`helm' for lsp workspace/symbol.
When called with prefix ARG the default selection will be symbol at point."
  (interactive "P")
  (helm-lsp--workspace-symbol (or (lsp-workspaces)
                                  (gethash (lsp-workspace-root default-directory)
                                           (lsp-session-folder->servers (lsp-session))))
                              "Workspace symbol"
                              (when arg (thing-at-point 'symbol))))

;;;###autoload
(defun helm-lsp-global-workspace-symbol (arg)
  "`helm' for lsp workspace/symbol for all of the current workspaces.
When called with prefix ARG the default selection will be symbol at point."
  (interactive "P")
  (helm-lsp--workspace-symbol (-uniq (-flatten (ht-values (lsp-session-folder->servers (lsp-session)))))
                              "Global workspace symbols"
                              (when arg (thing-at-point 'symbol))))

;;;###autoload
(defun helm-lsp-code-actions()
  "Show lsp code actions using helm."
  (interactive)
  (let ((actions (lsp-code-actions-at-point)))
    (cond
     ((seq-empty-p actions) (signal 'lsp-no-code-actions nil))
     ((and (eq (seq-length actions) 1) lsp-auto-execute-action)
      (lsp-execute-code-action (lsp-seq-first actions)))
     (t (helm :sources
              (helm-build-sync-source
                  "Code Actions"
                :candidates actions
                :candidate-transformer
                (lambda (candidates)
                  (-map
                   (-lambda ((candidate &as
                                        &CodeAction :title))
                     (list title :data candidate))
                   candidates))
                :action '(("Execute code action" . (lambda(candidate)
                                                     (lsp-execute-code-action (plist-get candidate :data)))))))))))



;; helm projects

(with-eval-after-load 'helm-projectile
  (defvar helm-lsp-source-projects
    (helm-build-sync-source
        "LSP projects"
      :candidates (lambda () (lsp-session-folders (lsp-session)))
      :fuzzy-match helm-projectile-fuzzy-match
      :keymap helm-projectile-projects-map
      :mode-line helm-read-file-name-mode-line-string
      :action 'helm-source-projectile-projects-actions)
    "Helm source for known LSP projects.")

  (defun helm-lsp-switch-project (&optional arg)
    "Use projectile with Helm for finding files in project
With a prefix ARG invalidates the cache first."
    (interactive "P")
    (let ((helm-ff-transformer-show-only-basename nil)
          (helm-boring-file-regexp-list nil))
      (helm :sources 'helm-lsp-source-projects
            :buffer (concat "*helm projectile: " (projectile-project-name) "*")
            :truncate-lines helm-projectile-truncate-lines
            :prompt (projectile-prepend-project-name "Switch to LSP project: ")))))

;; helm diagnostics

(defconst helm-lsp--diag-mapping
  `((,lsp/diagnostic-severity-error . error)
    (,lsp/diagnostic-severity-warning .  warning)
    (,lsp/diagnostic-severity-information . info)
    (,lsp/diagnostic-severity-hint . info)))

(lsp-defun helm-lsp--diag-matched
  (file (&Diagnostic :message
                     :source? :severity?
                     :range (&Range :start
                                    (&Position :line :character)))
        tokens)
  (-all? (lambda (token)

           (cl-case (aref token 0)
             (?# (s-matches? (substring token 1) file))
             (?* (s-contains? (substring token 1)
                              (symbol-name (alist-get severity? helm-lsp--diag-mapping))))
             (t (s-contains? token message))))
         tokens))

(lsp-defun helm-lsp-jump-to-error ((file start))
  "Go to selected symbol"
  (find-file file)
  (goto-char (lsp--position-to-point start)))

(lsp-defun helm-lsp-quick-fix ((file start))
  "Go to selected symbol and fix the action."
  (find-file file)
  (goto-char (lsp--position-to-point start))
  (call-interactively #'lsp-execute-code-action))

(defface helm-lsp-diag-error
  '((t :inherit error))
  "Face used for corresponding diag error level."
  :group 'lsp-faces)

(defface helm-lsp-diag-info
  '((t :inherit success))
  "Face used for corresponding diag error level."
  :group 'lsp-faces)

(defface helm-lsp-diag-warning
  '((t :inherit warning))
  "Face used for corresponding diag error level."
  :group 'lsp-faces)

(defcustom helm-lsp-diag-face-map
  `((,lsp/diagnostic-severity-error . helm-lsp-diag-error)
    (,lsp/diagnostic-severity-warning . helm-lsp-diag-warning)
    (,lsp/diagnostic-severity-information . helm-lsp-diag-info)
    (,lsp/diagnostic-severity-hint . helm-lsp-diag-info))
  "Alist diagnostics to face."
  :type 'alist)

(defun helm-lsp--diagnostics-transform (candidates)
  (let ((tokens (helm-mm-split-pattern helm-pattern)))
    (->>
     candidates
     (-keep (-lambda ((full-path file (diag &as &Diagnostic :message
                                            :source? :severity?
                                            :range (&Range :start (start &as &Position :line :character)) )))
              (when (helm-lsp--diag-matched full-path diag tokens)
                (list (format
                       "%s%s %s %s %s%s"
                       (if (fboundp 'lsp-treemacs-get-icon)
                           (lsp-treemacs-get-icon (alist-get severity?
                                                             helm-lsp--diag-mapping))
                         (propertize
                          (format "[%s] " (alist-get severity? helm-lsp--diag-mapping))
                          'face
                          (alist-get severity? helm-lsp-diag-face-map)))
                       (propertize (format "[%s]" source?) 'face 'lsp-details-face)
                       source? message
                       (propertize file 'face 'lsp-details-face)
                       (propertize (format ":%s:%s" line character) 'face 'lsp-details-face))
                      full-path start))))
     (-sort (-lambda ((full-path-1 _ (&Diagnostic :range
                                                  (&Range? :start (&Position? :line l1 :character c1))))
                      (full-path-2 _ (&Diagnostic :range
                                                  (&Range? :start (&Position? :line l2 :character c2)))))
              (if (string= full-path-1 full-path-2)
                  (cond
                   ((not l1) t)
                   ((not l2) nil)
                   (t (if (eq l1 l2) (< c1 c2) (< l1 l2))))
                (string< full-path-1 full-path-2)))))))


;;;###autoload
(defun helm-lsp-diagnostics (arg)
  "Diagnostics using `helm'"
  (interactive "P")
  (if (get-buffer "*helm-lsp-diagnostics*")
      (progn
        (run-with-timer 0 nil #'helm-update)
        (helm-resume "*helm-lsp-diagnostics*"))
    (helm
     :sources
     (helm-build-sync-source "Diagnostics"
       :mode-line (list "Diagnostics(s)")
       :candidates (lambda ()
                     (->> (lsp-diagnostics)
                          (ht-map (lambda (file v)
                                    (-map (-partial #'list
                                                    file
                                                    (if-let ((wks (lsp-workspace-root file)))
                                                        (f-relative file wks)
                                                      file))
                                          v)))
                          (apply #'append)))
       :action '(("Goto diagnostic" . helm-lsp-jump-to-error)
                 ("Quick fix" . helm-lsp-quick-fix))
       :persistent-action #'helm-lsp-jump-to-error
       :match (-const t)
       :volatile t
       :candidate-transformer #'helm-lsp--diagnostics-transform)
     :candidate-number-limit nil
     :buffer "*helm-lsp-diagnostics*")))

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