;;; mcp-hub.el --- manager mcp server                -*- lexical-binding: t; -*-

;; Copyright (C) 2025  lizqwer scott

;; Author: lizqwer scott <lizqwerscott@gmail.com>
;; Keywords: tools

;; 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:

;;

;;; Code:

(require 'mcp)

(defcustom mcp-hub-servers nil
  "Configuration for MCP servers.
Each server configuration is a list of the form
 (NAME . (:command COMMAND :args ARGS)) or (NAME . (:url URL)), where:
- NAME is a string identifying the server.
- COMMAND is the command to start the server.
- ARGS is a list of arguments passed to the command.
- URL is a string arguments to connect sse mcp server.
- ROOTS is a list of directory paths to expose to the server.
- TIMEOUT is the timeout in seconds for jsonrpc async requests.
  Defaults to `jsonrpc-default-request-timeout'."
  :group 'mcp-hub
  :type
  '(alist
    :key-type string
    :value-type
    (plist
     :options
     ((:command string)
      (:args (repeat string))
      (:url string)
      (:roots (repeat directory))
      (:timeout integer)))))

(defun mcp-hub--start-server (server &optional inited-callback syncp)
  "Start an MCP server with the given configuration.
SERVER should be a cons cell of the form (NAME . CONFIG) where:
- NAME is a string identifying the server
- CONFIG is a plist containing either:
  - :command and :args for local servers
  - :url for remote servers

Optional argument INITED-CALLBACK is a function called when the server
has successfully initialized and tools are available. The callback
receives no arguments.

Optional argument SYNCP is a boolean and decides if the operation runs
synchronously (non-nil) or asynchronously (nil)."
  (apply #'mcp-connect-server
         (append (list (car server))
                 (cdr server)
                 (list :initial-callback
                       (lambda (_)
                         (mcp-hub-update))
                       :tools-callback
                       (lambda (_ _)
                         (mcp-hub-update)
                         (when inited-callback
                           (funcall inited-callback)))
                       :prompts-callback
                       (lambda (_ _)
                         (mcp-hub-update))
                       :resources-callback
                       (lambda (_ _)
                         (mcp-hub-update))
                       :resources-templates-callback
                       (lambda (_ _)
                         (mcp-hub-update))
                       :error-callback
                       (lambda (_ _)
                         (mcp-hub-update))
                       :syncp syncp))))

;;;###autoload
(cl-defun mcp-hub-get-all-tool (&key asyncp categoryp)
  "Retrieve all available tools from connected MCP servers.
This function collects all tools from currently connected MCP servers,
filtering out any invalid entries. Each tool is created as a text tool
that can be used for interaction.

When ASYNCP is non-nil, the tools will be created asynchronously.

When CATEGORYP is non-nil, the tools will be add to a category.

Returns a list of text tools created from all valid tools across all
connected servers. The list excludes any tools that couldn't be created
due to missing or invalid names.

Example:
  (mcp-hub-get-all-tool)  ; Get all tools synchronously
  (mcp-hub-get-all-tool t)  ; Get all tools asynchronously"
  (let ((res ))
    (maphash (lambda (name server)
               (when (and server
                          (equal (mcp--status server)
                                 'connected))
                 (when-let* ((tools (mcp--tools server))
                             (tool-names (mapcar (lambda (tool) (plist-get tool :name)) tools)))
                   (dolist (tool-name tool-names)
                     (push (let ((tool (mcp-make-text-tool name tool-name asyncp)))
                             (if categoryp
                                 (plist-put
                                  tool
                                  :category
                                  (format "mcp-%s"
                                          name))
                               tool))
                           res)))))
             mcp-server-connections)
    (nreverse res)))

;;;###autoload
(defun mcp-hub-start-all-server (&optional callback servers syncp)
  "Start all configured MCP servers.
This function will attempt to start each server listed in `mcp-hub-servers'
if it's not already running.

Optional argument CALLBACK is a function to be called when all servers have
either started successfully or failed to start.The callback receives no
arguments.

Optional argument SERVERS is a list of server names (strings) to filter which
servers should be started. When nil, all configured servers are considered.

Optional argument SYNCP is a boolean. When non-nil, the servers are
started synchronously."
  (interactive)
  (let* ((servers-to-start (cl-remove-if (lambda (server)
                                           (or (and servers
                                                    (not (cl-find (car server) servers :test #'string=)))
                                               (mcp--server-running-p (car server))))
                                         mcp-hub-servers))
         (total (length servers-to-start))
         (started 0))
    (if (zerop total)
        (progn
          (message "All MCP servers already running")
          (when callback (funcall callback)))
      (message "Starting %d MCP server(s)..." total)
      (dolist (server servers-to-start)
        (condition-case err
            (mcp-hub--start-server
             server
             (lambda ()
               (cl-incf started)
               (message "Started server %s (%d/%d)" (car server) started total)
               (when (and callback (>= started total))
                 (funcall callback)))
             syncp)
          (error
           (message "Failed to start server %s: %s" (car server) err)
           (cl-incf started)
           (when (and callback (>= started total))
             (funcall callback))))))))

;;;###autoload
(defun mcp-hub-close-all-server ()
  "Stop all running MCP servers.
This function will attempt to stop each server listed in `mcp-hub-servers'
that is currently running."
  (interactive)
  (dolist (server mcp-hub-servers)
    (when (gethash (car server)
                   mcp-server-connections)
      (mcp-stop-server (car server))))
  (mcp-hub-update))

;;;###autoload
(defun mcp-hub-restart-all-server ()
  "Restart all configured MCP servers.
This function first stops all running servers, then starts them again.
It's useful for applying configuration changes or recovering from errors."
  (interactive)
  (mcp-hub-close-all-server)
  (mcp-hub-start-all-server))

(defun mcp-hub-get-servers ()
  "Retrieve status information for all configured servers.
Returns a list of server statuses, where each status is a plist containing:
- :name - The server's name
- :status - Either `connected' or `stop'
- :tools - Available tools (if connected)
- :resources - Available resources (if connected)
- :template-resources - Available template resources (if connected)
- :prompts - Available prompts (if connected)
- :roots - Available roots (if connected)"
  (mapcar (lambda (server)
            (let ((name (car server)))
              (if-let* ((connection (gethash name mcp-server-connections)))
                  (list :name name
                        :type (mcp--connection-type connection)
                        :status (mcp--status connection)
                        :tools (mcp--tools connection)
                        :resources (mcp--resources connection)
                        :template-resources (mcp--template-resources connection)
                        :prompts (mcp--prompts connection)
                        :roots (mcp--roots connection))
                (list :name name :status 'stop))))
          mcp-hub-servers))

(defun mcp-hub-update (&optional ignore-auto noconfirm)
  "Update the MCP Hub display with current server status.
If called interactively, ARG is the prefix argument.
When SILENT is non-nil, suppress any status messages.
This function refreshes the *Mcp-Hub* buffer with the latest server information,
including connection status, available tools, resources, template resources and
prompts."
  (interactive)
  (ignore ignore-auto noconfirm) ; unused variables
  (when-let* ((server-list (mcp-hub-get-servers))
              (server-show (mapcar (lambda (server)
                                     (let* ((name (plist-get server :name))
                                            (status (plist-get server :status)))
                                       (append (list name
                                                     (symbol-name (plist-get server :type))
                                                     (pcase status
                                                       ('connected
                                                        (propertize (symbol-name status)
                                                                    'face 'success))
                                                       ('error
                                                        (propertize (symbol-name status)
                                                                    'face 'error))
                                                       (_
                                                        (symbol-name status))))
                                               (if (equal status 'connected)
                                                   (mapcar (lambda (x)
                                                             (format "%d"
                                                                     (length x)))
                                                           (list (plist-get server :tools)
                                                                 (plist-get server :resources)
                                                                 (plist-get server :template-resources)
                                                                 (plist-get server :prompts)))
                                                 (list "nil" "nil" "nil" "nil")))))
                                   server-list)))
    (with-current-buffer (get-buffer-create "*Mcp-Hub*")
      (setq tabulated-list-entries
            (cl-mapcar (lambda (statu index)
                         (list (format "%d" index)
                               (vconcat statu)))
                       server-show
                       (number-sequence 1 (length server-list))))
      (tabulated-list-print t))))

;;;###autoload
(defun mcp-hub (&optional start)
  "View mcp hub server.
Start all server if START is non-nil or if called interactively with a prefix
argument."
  (interactive "P")
  ;; start all server
  (when (and start
             mcp-hub-servers
             (= (hash-table-count mcp-server-connections)
                0))
    (mcp-hub-start-all-server))
  ;; show buffer
  (pop-to-buffer "*Mcp-Hub*" nil)
  (mcp-hub-mode))

;;;###autoload
(defun mcp-hub-start-server ()
  "Start the currently selected MCP server.
This function starts the server that is currently highlighted in the *Mcp-Hub*
buffer. It sets up callbacks for connection status, tools, prompts, and
resources updates, and refreshes the hub view after starting the server."
  (interactive)
  (when-let* ((server (tabulated-list-get-entry))
              (name (elt server 0))
              (server-arg (cl-find name mcp-hub-servers :key #'car :test #'equal)))
    (mcp-hub--start-server server-arg)
    (mcp-hub-update)))

;;;###autoload
(defun mcp-hub-close-server ()
  "Stop the currently selected MCP server.
This function stops the server that is currently highlighted in the *Mcp-Hub*
buffer and updates the hub view to reflect the change in status."
  (interactive)
  (when-let* ((server (tabulated-list-get-entry))
              (name (elt server 0)))
    (mcp-stop-server name)
    (mcp-hub-update)))

;;;###autoload
(defun mcp-hub-restart-server ()
  "Restart the currently selected MCP server.
This function stops and then starts the server that is currently highlighted
in the *Mcp-Hub* buffer. It's useful for applying configuration changes or
recovering from errors."
  (interactive)
  (mcp-hub-close-server)
  (mcp-hub-start-server))

;;;###autoload
(defun mcp-hub-view-log ()
  "View the event log for the currently selected MCP server.
This function opens a buffer showing the event log for the server that is
currently highlighted in the *Mcp-Hub* buffer."
  (interactive)
  (when-let* ((server (tabulated-list-get-entry))
              (name (elt server 0)))
    (switch-to-buffer (format "*%s events*"
                              name))))

(define-derived-mode mcp-hub-mode tabulated-list-mode "Mcp Hub"
  "A major mode for viewing a list of mcp server."
  (setq-local revert-buffer-function #'mcp-hub-update)
  (setq tabulated-list-format
        [("Name" 18 t)
         ("Type" 10 t)
         ("Status" 15 t)
         ("Tools" 10 t)
         ("Resources" 10 t)
         ("Template" 10 t)
         ("Prompts" 10 t)])
  (setq tabulated-list-padding 2)
  (setq tabulated-list-sort-key '("Name" . nil))
  (tabulated-list-init-header)

  (keymap-set mcp-hub-mode-map "l" #'mcp-hub-view-log)
  (keymap-set mcp-hub-mode-map "s" #'mcp-hub-start-server)
  (keymap-set mcp-hub-mode-map "k" #'mcp-hub-close-server)
  (keymap-set mcp-hub-mode-map "r" #'mcp-hub-restart-server)
  (keymap-set mcp-hub-mode-map "S" #'mcp-hub-start-all-server)
  (keymap-set mcp-hub-mode-map "R" #'mcp-hub-restart-all-server)
  (keymap-set mcp-hub-mode-map "K" #'mcp-hub-close-all-server)
  (keymap-set mcp-hub-mode-map "+" #'mcp-hub-add-root)
  (keymap-set mcp-hub-mode-map "-" #'mcp-hub-remove-root)
  (keymap-set mcp-hub-mode-map "=" #'mcp-hub-view-roots)
  (keymap-set mcp-hub-mode-map "d" #'mcp-hub-show-server-detail)

  (mcp-hub-update))

;;;###autoload
(defun mcp-hub-add-root ()
  "Add a root directory to the currently selected MCP server.
Prompts for a directory path and adds it to the server's roots."
  (interactive)
  (when-let* ((server (tabulated-list-get-entry))
              (name (elt server 0))
              (dir (read-directory-name "Root directory: ")))
    (mcp-add-root name (expand-file-name dir))
    (message "Added root %s to server %s" dir name)
    (mcp-hub-update)))

;;;###autoload
(defun mcp-hub-remove-root ()
  "Remove a root directory from the currently selected MCP server.
Prompts for selection from the server's current roots."
  (interactive)
  (when-let* ((server (tabulated-list-get-entry))
              (name (elt server 0))
              (roots (mcp-get-roots name)))
    (if (null roots)
        (message "Server %s has no roots" name)
      (let* ((root-strings (mapcar (lambda (root)
                                     (if (stringp root)
                                         root
                                       (or (plist-get root :uri)
                                           (format "%S" root))))
                                   roots))
             (selected (completing-read "Remove root: " root-strings nil t))
             (root-to-remove (cl-find selected roots
                                      :test (lambda (str root)
                                              (equal str (if (stringp root)
                                                             root
                                                           (plist-get root :uri)))))))
        (when root-to-remove
          (mcp-remove-root name root-to-remove)
          (message "Removed root %s from server %s" selected name)
          (mcp-hub-update))))))

;;;###autoload
(defun mcp-hub-view-roots ()
  "View the roots for the currently selected MCP server."
  (interactive)
  (when-let* ((server (tabulated-list-get-entry))
              (name (elt server 0))
              (roots (mcp-get-roots name)))
    (if (null roots)
        (message "Server %s has no roots" name)
      (with-current-buffer (get-buffer-create (format "*%s roots*" name))
        (let ((inhibit-read-only t))
          (erase-buffer)
          (insert (format "Roots for server: %s\n\n" name))
          (dolist (root roots)
            (if (stringp root)
                (insert (format "  - %s\n" root))
              (insert (format "  - %s (%s)\n"
                              (plist-get root :uri)
                              (plist-get root :name)))))
          (goto-char (point-min))
          (special-mode))
        (pop-to-buffer (current-buffer))))))

;;;###autoload
(defun mcp-hub-show-server-detail ()
  "View the detail info for the currently selected MCP server."
  (interactive)
  (when-let* ((server (tabulated-list-get-entry))
              (name (elt server 0)))
    (if-let* ((connection (gethash name mcp-server-connections)))
        (with-current-buffer (get-buffer-create (format "*Mcp server %s detail*" name))
          (mcp-hub-detail--render name connection)
          (mcp-hub-detail-mode)
          (pop-to-buffer (current-buffer)))
      (message "Server %s is not connected" name))))

(require 'outline)

(defun mcp-hub-detail-imenu-index-function ()
  "Mcp detail mode imenu index function."
  (let ((alist '()) (sub '()) section)
    (save-excursion
      (goto-char (point-min))
      (while (not (eobp))
        (pcase (get-text-property (point) 'face)
          ('outline-1
           (when sub
             (push (cons (car (car alist)) (nreverse sub)) alist)
             (setq sub nil))
           (setq section (buffer-substring-no-properties (point) (line-end-position)))
           (push (cons section (point)) alist))
          ('outline-2
           (push (cons (buffer-substring-no-properties (point) (line-end-position))
                       (point)) sub)))
        (forward-line 1))
      (when sub
        (setq alist (nconc (nreverse (cdr alist))
                           (list (cons (caar alist) (nreverse sub))))))
      (nreverse alist))))

(define-derived-mode mcp-hub-detail-mode special-mode "MCP Hub Detail"
  "Major mode for displaying MCP server information with outline support."

  (setq-local buffer-read-only t)

  (setq-local imenu-create-index-function #'mcp-hub-detail-imenu-index-function)

  (define-key mcp-hub-detail-mode-map (kbd "n") #'mcp-hub-detail-next-heading)
  (define-key mcp-hub-detail-mode-map (kbd "p") #'mcp-hub-detail-previous-heading)
  (define-key mcp-hub-detail-mode-map (kbd "RET") #'mcp-hub-detail-reading-resource)

  (define-key mcp-hub-detail-mode-map (kbd "g") #'mcp-hub-detail-refresh))

(defun mcp-hub-detail--render (name connection)
  "Render detail content for server NAME with CONNECTION."
  (let ((inhibit-read-only t))
    (erase-buffer)

    ;; Server header
    (insert (propertize (format "%s\n" name)
                        'face '(font-lock-keyword-face (:height 2.0 :weight bold))
                        'mcp-server-name name))
    (insert (make-string (length (format "Server: %s" name)) ?-) "\n\n")

    ;; Server status
    (insert (propertize "Status:\n" 'face 'outline-1))
    (insert (format "  Running: %s\n" (if (mcp--server-running-p name) "Yes" "No")))
    (insert (format "  Connection type: %s\n" (mcp--connection-type connection)))
    (insert "\n")

    ;; Server info
    (when-let* ((server-info (mcp--server-info connection)))
      (insert (propertize "Server Information:\n" 'face 'outline-1))
      (insert (format "  Name: %s\n" (or (plist-get server-info :name) "Unknown")))
      (insert (format "  Version: %s\n" (or (plist-get server-info :version) "Unknown")))
      (when-let* ((description (plist-get server-info :description)))
        (insert (format "  Description: %s\n" description)))
      (insert "\n"))

    ;; Tools
    (when-let* ((tools (mcp--tools connection)))
      (insert (propertize (format "Tools (%d):\n" (length tools)) 'face 'outline-1))
      (cl-loop for i from 0 below (length tools)
               for tool = (aref tools i)
               do (let ((tool-name (plist-get tool :name))
                        (description (plist-get tool :description)))
                    (insert (propertize (format "  • %s" tool-name) 'face 'outline-2))
                    (insert "\n")
                    (when description
                      (insert (format "    %s\n" description)))))
      (insert "\n"))

    ;; Resources
    (when-let* ((resources (mcp--resources connection)))
      (insert (propertize (format "Resources (%d):\n" (length resources)) 'face 'outline-1))
      (cl-loop for i from 0 below (length resources)
               for resource = (if (vectorp resources) (aref resources i) (nth i resources))
               do (let ((uri (plist-get resource :uri))
                        (name (plist-get resource :name))
                        (description (plist-get resource :description)))
                    (insert (propertize (format "  • %s" name) 'face 'outline-2 'resource-uri uri))
                    (when uri
                      (insert (format " (%s)" (propertize uri 'face 'font-lock-string-face 'resource-uri uri))))
                    (insert "\n")
                    (when description
                      (insert (format "    %s\n" description)))))
      (insert "\n"))

    ;; Template Resources
    (when-let* ((templates (mcp--template-resources connection)))
      (insert (propertize (format "Resource Templates (%d):\n" (length templates)) 'face 'outline-1))
      (cl-loop for i from 0 below (length templates)
               for template = (if (vectorp templates) (aref templates i) (nth i templates))
               do (let ((uri-template (plist-get template :uriTemplate))
                        (name (plist-get template :name))
                        (description (plist-get template :description)))
                    (insert (propertize (format "  • %s" name) 'face 'outline-2))
                    (when uri-template
                      (insert (format " (%s)" (propertize uri-template 'face 'font-lock-string-face))))
                    (insert "\n")
                    (when description
                      (insert (format "    %s" description)))
                    (insert "\n")))
      (insert "\n"))

    ;; Prompts
    (when-let* ((prompts (mcp--prompts connection)))
      (insert (propertize (format "Prompts (%d):\n" (length prompts)) 'face 'outline-1))
      (cl-loop for i from 0 below (length prompts)
               for prompt = (if (vectorp prompts) (aref prompts i) (nth i prompts))
               do (let ((name (plist-get prompt :name))
                        (description (plist-get prompt :description)))
                    (message "Prompts: %s" prompt)
                    (insert (propertize (format "  • %s" name) 'face 'outline-2))
                    (insert "\n")
                    (when description
                      (insert (format "    %s" description)))
                    (insert "\n")))
      (insert "\n"))

    ;; Roots
    (when-let* ((roots (mcp--roots connection)))
      (insert (propertize (format "Roots (%d):\n" (length roots)) 'face 'outline-1))
      (cl-loop for i from 0 below (length roots)
               for root = (if (vectorp roots) (aref roots i) (nth i roots))
               do (if (stringp root)
                      (insert (propertize (format "  • %s" root) 'face 'outline-2))
                    (insert (propertize (format "  • %s" (plist-get root :name)) 'face 'font-lock-variable-name-face))
                    (insert (format " (%s)" (propertize (plist-get root :uri) 'face 'font-lock-string-face))))
               (insert "\n")))

    (goto-char (point-min))))

;;;###autoload
(defun mcp-hub-detail-refresh ()
  "Refresh current server info."
  (interactive)
  (when-let* ((name (get-text-property (point-min) 'mcp-server-name)))
    (if-let* ((connection (gethash name mcp-server-connections)))
        (progn
          (message "Update server info...")
          (mcp-hub-detail--render name connection)
          (message "Update server info...done"))
      (message "Server %s is not connected" name))))

;;;###autoload
(defun mcp-hub-detail-next-heading ()
  "Next title."
  (interactive)
  (let ((pos (next-single-property-change (point) 'face)))
    (while (and pos (not (memq (get-text-property pos 'face) '(outline-1 outline-2))))
      (setq pos (next-single-property-change pos 'face)))
    (if pos
        (goto-char pos)
      (message "No more headings"))))

;;;###autoload
(defun mcp-hub-detail-previous-heading ()
  "Previous title."
  (interactive)
  (let ((pos (previous-single-property-change (point) 'face)))
    (while (and pos
                (not (memq (get-text-property pos 'face) '(outline-1 outline-2))))
      (setq pos (previous-single-property-change pos 'face)))
    (if pos
        (goto-char pos)
      (message "No previous headings"))))

;;;###autoload
(defun mcp-hub-detail-reading-resource ()
  "Read resource file from the detail buffer.

Get the resource URI at point, look up the connection from the buffer's
server name, then fetch and display the resource content."
  (interactive)
  (let* ((uri (get-text-property (point) 'resource-uri))
         (name (get-text-property (point-min) 'mcp-server-name))
         (connection (and name (gethash name mcp-server-connections))))
    (unless uri
      (user-error "No resource URI at point"))
    (unless connection
      (user-error "Server %s is not connected" name))
    (message "Reading resource: %s..." uri)
    (condition-case err
        (let ((result (mcp-read-resource connection uri)))
          (mcp-hub-detail--display-resource result uri)
          (message "Reading resource: %s...done" uri))
      (error
       (message "Failed to read resource %s: %s" uri (error-message-string err))))))

(defun mcp-hub-detail--display-resource (result uri)
  "Display RESULT from reading URI in a dedicated buffer.

Per the MCP spec (resources/read), RESULT contains :contents, which is an
array of content objects. Each content object has:
  - :uri  — the URI of the resource
  - :mimeType — optional MIME type (e.g. \"text/plain\")
  - :text  — text content (for text resources)
  - :blob  — base64-encoded string (for binary resources)"
  (let* ((buf (get-buffer-create (format "*Mcp Resource: %s*" uri)))
         (contents (plist-get result :contents))
         (parts (if (vectorp contents)
                    contents
                  (vector contents)))
         (text (mapconcat
                (lambda (item)
                  (let ((mime (plist-get item :mimeType))
                        (text-content (plist-get item :text))
                        (blob (plist-get item :blob)))
                    (cond
                     (text-content
                      (if (and mime (not (string-prefix-p "text/" mime)))
                          (format "[MIME: %s]\n%s" mime text-content)
                        text-content))
                     (blob
                      (format "[Binary: %s, base64 %d bytes]"
                              (or mime "application/octet-stream")
                              (length blob)))
                     (t (prin1-to-string item)))))
                parts "\n---\n")))
    (with-current-buffer buf
      (let ((inhibit-read-only t))
        (erase-buffer)
        (insert text))
      (goto-char (point-min))
      (setq-local header-line-format (format "Resource: %s" uri))
      ;; Detect major mode from MIME type or URI extension
      (special-mode))
    (display-buffer buf)))

(provide 'mcp-hub)
;;; mcp-hub.el ends here
