;;;; src/tools/registry.lisp

(in-package :cl-tron-mcp/tools)

(defvar *tool-registry* (make-hash-table :test 'equal))

(defun normalize-argument-key (key)
  "Convert an incoming MCP argument key to the snake_case keyword expected by handlers."
  (let* ((raw (string key))
         (normalized
           (with-output-to-string (out)
             (loop for i from 0 below (length raw)
                   for ch = (char raw i)
                   for prev = (and (> i 0) (char raw (1- i)))
                   do (cond
                        ((char= ch #\-)
                         (write-char #\_ out))
                        ((and (alpha-char-p ch)
                              (char= ch (char-upcase ch))
                              (char/= ch (char-downcase ch))
                              prev
                              (or (lower-case-p prev)
                                  (digit-char-p prev)))
                         (write-char #\_ out)
                         (write-char ch out))
                        (t
                         (write-char (char-upcase ch) out)))))))
    (intern normalized :keyword)))

(defstruct tool-entry
  name
  descriptor
  handler)

(defun register-tool (name description &key input-schema output-schema requires-approval documentation-uri concurrency)
  "Register a tool with descriptor and handler.
   requires-approval t means approvalLevel \"user\" (human must approve); nil means \"none\" (auto-run)."
  (let ((descriptor (make-hash-table :test 'equal)))
    (setf (gethash :name descriptor) name)
    (setf (gethash :description descriptor) description)
    (setf (gethash :inputSchema descriptor) (or input-schema (make-hash-table :test 'equal)))
    (setf (gethash :outputSchema descriptor) (or output-schema (make-hash-table :test 'equal)))
    (setf (gethash :requiresApproval descriptor) (or requires-approval nil))
    (setf (gethash :approvalLevel descriptor) (if requires-approval "user" "none"))
    (setf (gethash :documentationUri descriptor) documentation-uri)
    (setf (gethash :concurrency descriptor) (or concurrency "sequential"))
    (setf (gethash name *tool-registry*)
          (make-tool-entry :name name
                           :descriptor descriptor
                           :handler nil))))

(defun register-tool-handler (name handler)
  "Register handler function for already registered tool."
  (let ((entry (gethash name *tool-registry*)))
    (when entry
      (setf (tool-entry-handler entry) handler))))

(defun list-tool-descriptors ()
  "Get list of all tool descriptors."
  (let ((descriptors (make-array 0 :adjustable t :fill-pointer 0)))
    (maphash (lambda (name entry)
               (declare (ignore name))
               (vector-push-extend (tool-entry-descriptor entry) descriptors))
             *tool-registry*)
    (coerce descriptors 'list)))

(defun get-tool-handler (name)
  "Get handler function for tool."
  (let ((entry (gethash name *tool-registry*)))
    (when entry
      (tool-entry-handler entry))))

(defun get-tool-descriptor (name)
  "Get tool descriptor (hash table) for tool NAME, or nil if unknown."
  (let ((entry (gethash name *tool-registry*)))
    (when entry
      (tool-entry-descriptor entry))))

(defun tool-requires-user-approval-p (name)
  "Return t if tool NAME has approval level user (requires human approval)."
  (let ((desc (get-tool-descriptor name)))
    (and desc (gethash :requiresApproval desc))))

(defun call-tool (name arguments)
  "Call tool by name with arguments plist.
The plist keys are JSON-style (e.g., :|port|) and converted to proper keywords (:PORT)."
  (let ((handler (get-tool-handler name)))
    (unless handler
      (error "Unknown tool: ~a" name))
    (let ((args-list (loop for (key value) on arguments by #'cddr
                           for keyword = (normalize-argument-key key)
                           append (list keyword value))))
      (apply handler args-list))))

(defun load-all-tools ()
  "No-op: tool files are loaded by ASDF in dependency order as declared in cl-tron-mcp.asd.
This function is kept for backward compatibility but performs no action."
  nil)
