;;; acp.el --- An ACP (Agent Client Protocol) implementation -*- lexical-binding: t; -*-

;; Copyright (C) 2024 Alvaro Ramirez

;; Author: Alvaro Ramirez https://xenodium.com
;; URL: https://github.com/xenodium/acp.el
;; Package-Version: 0.13.1
;; Package-Revision: a29cb161ac95
;; Package-Requires: ((emacs "28.1"))

(defconst acp-package-version "0.13.1")

;; This package 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, or (at your option)
;; any later version.

;; This package 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 GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.

;;; Commentary:
;;
;; acp.el implements ACP (Agent Client Protocol) as per spec
;; https://agentclientprotocol.com
;;
;; Note: This package is in the very early stage and is likely
;; incomplete or may have some rough edges.
;;
;; Report issues at https://github.com/xenodium/acp.el/issues
;;
;; ✨ Please support this work https://github.com/sponsors/xenodium ✨

;;; Code:

(require 'map)
(require 'json)
(eval-when-compile
  (require 'cl-lib))
(require 'acp-traffic)

(defconst acp--jsonrpc-version "2.0")

(defgroup acp nil
  "ACP (Agent Client Protocol) implementation."
  :group 'tools
  :prefix "acp-")

(defcustom acp-logging-enabled nil
  "Whether to log ACP traffic and messages to the logs buffer.
See `acp-logs-buffer' to view the resulting log."
  :type 'boolean
  :group 'acp)

(defvar acp-instance-count 0)

(cl-defun acp-make-client (&key context-buffer command command-params environment-variables
                                request-sender notification-sender request-resolver
                                response-sender outgoing-request-decorator)
  "Create an ACP client.

This returns a alist representing the client.

CONTEXT-BUFFER becomes `current-buffer' for all APIs invoking callbacks
unless overridden by them.  For example:

  - `acp-send-request'
  - `acp-subscribe-to-notifications'
  - `acp-subscribe-to-requests'
  - `acp-subscribe-to-errors'

COMMAND is the binary or command-line utility to invoke.
COMMAND-PARAMS is a list of strings for command arguments.
ENVIRONMENT-VARIABLES is a list of strings in the form \"VAR=foo\".

REQUEST-SENDER, NOTIFICATION-SENDER, REQUEST-RESOLVER, and RESPONSE-SENDER are
functions for advanced customization or testing.

OUTGOING-REQUEST-DECORATOR is an optional function of the form
\(lambda (request) ...) that receives the JSON-RPC request object
before it is sent and returns a (possibly modified) request.
If the decorator returns nil, the original request is sent and
the error is logged."
  (unless command
    (error ":command is required"))
  (list (cons :context-buffer context-buffer)
        (cons :instance-count (acp--increment-instance-count))
        (cons :process nil)
        (cons :command command)
        (cons :command-params command-params)
        (cons :environment-variables environment-variables)
        (cons :pending-requests ())
        (cons :request-id 0)
        (cons :notification-handlers ())
        (cons :request-handlers ())
        (cons :error-handlers ())
        (cons :request-sender (or request-sender #'acp--request-sender))
        (cons :notification-sender (or notification-sender #'acp--notification-sender))
        (cons :request-resolver (or request-resolver #'acp--request-resolver))
        (cons :response-sender (or response-sender #'acp--response-sender))
        (cons :outgoing-request-decorator outgoing-request-decorator)))

(defun acp--client-started-p (client)
  "Return non-nil if CLIENT process has been started."
  (and (map-elt client :process)
       (process-live-p (map-elt client :process))))

(cl-defun acp--start-client (&key client)
  "Start CLIENT."
  (unless client
    (error ":client is required"))
  (unless (map-elt client :command)
    (error ":command is required"))
  (unless (executable-find (map-elt client :command)
                           (file-remote-p default-directory))
    (error "\"%s\" command line utility not found.  Please install it" (map-elt client :command)))
  (when (acp--client-started-p client)
    (error "Client already started"))
  (let* ((coding-system-for-read 'utf-8-unix)
         (coding-system-for-write 'utf-8-unix)
         (pending-input "")
         (message-queue nil)
         (message-queue-busy nil)
         (process-environment (append (map-elt client :environment-variables)
                                      process-environment))
         (stderr-buffer (get-buffer-create (format "acp-client-stderr(%s)-%s"
                                                   (map-elt client :command)
                                                   (map-elt client :instance-count)))))
    (with-current-buffer stderr-buffer
      (add-hook 'after-change-functions
                (lambda (beg end _len)
                  (let ((raw-output (buffer-substring-no-properties beg end)))
                    (acp--log client "STDERR" "%s" (string-trim raw-output))
                    (when-let* ((std-error (cond
                                            ((acp--parse-stderr-api-error raw-output)
                                             (acp--parse-stderr-api-error raw-output))
                                            ((not (string-empty-p (string-trim raw-output)))
                                             ;; Fallback: create a generic error response
                                             (acp--make-internal-error raw-output)))))
                      (acp--log client "API-ERROR" "%s" (string-trim raw-output))
                      (dolist (handler (map-elt client :error-handlers))
                        (funcall handler std-error)))))
                nil t))
    (let ((process (make-process
                    :name (format "acp-client(%s)-%s"
                                  (map-elt client :command)
                                  (map-elt client :instance-count))
                    :command (cons (map-elt client :command)
                                   (map-elt client :command-params))
                    :stderr stderr-buffer
                    :connection-type 'pipe
                    :noquery t
                    ;; Start the process with TRAMP if `default-directory' is remote
                    :file-handler (file-remote-p default-directory)
                    :filter (lambda (_proc input)
                              (acp--log client "INCOMING TEXT" "%s" input)
                              (setq pending-input (concat pending-input input))
                              (let ((start 0) pos)
                                (while (setq pos (string-search "\n" pending-input start))
                                  (let ((json (substring pending-input start pos)))
                                    (acp--log client "INCOMING LINE" "%s" json)
                                    (when-let* ((object (condition-case nil
                                                            (acp--parse-json json)
                                                          (error
                                                           (acp--log client "JSON PARSE ERROR" "Invalid JSON: %s" json)
                                                           nil))))
                                      (setq message-queue
                                            (append message-queue
                                                    (list (acp--make-message :json json :object object))))
                                      (unless message-queue-busy
                                        (setq message-queue-busy t)
                                        (run-at-time 0 nil
                                                     (lambda ()
                                                       (while message-queue
                                                         ;; Bind print variables so the debugger
                                                         ;; can safely print the client alist
                                                         ;; without infinite recursion (#360).
                                                         (let ((message (car message-queue))
                                                               ;; Handle circular refs in client alist.
                                                               (print-circle t)
                                                               ;; Cap nesting depth.
                                                               (print-level 25)
                                                               ;; Cap list elements printed.
                                                               (print-length 200))
                                                           (setq message-queue (cdr message-queue))
                                                           (acp--route-incoming-message
                                                            :message message
                                                            :client client
                                                            :on-notification
                                                            (lambda (notification)
                                                              (dolist (handler (map-elt client :notification-handlers))
                                                                (condition-case-unless-debug err
                                                                    (funcall handler notification)
                                                                  (error
                                                                   (acp--log client "NOTIFICATION HANDLER ERROR"
                                                                             "Failed with error: %S" err)))))
                                                            :on-request
                                                            (lambda (request)
                                                              (dolist (handler (map-elt client :request-handlers))
                                                                (condition-case-unless-debug err
                                                                    (funcall handler request)
                                                                  (error
                                                                   (acp--log client "REQUEST HANDLER ERROR"
                                                                             "Failed with error: %S" err))))))))
                                                       (setq message-queue-busy nil))))))
                                  (setq start (1+ pos)))
                                (setq pending-input (substring pending-input start))))
                    :sentinel (lambda (process event)
                                (when (buffer-live-p stderr-buffer)
                                  (kill-buffer stderr-buffer))
                                (when (memq (process-status process) '(exit signal))
                                  (acp--fail-pending-requests :client client :event event))))))
      (map-put! client :process process))))

(defun acp--make-internal-error (message)
  "Build a synthetic JSON-RPC-shaped error alist with MESSAGE.

Used for errors synthesized locally rather than received from the
agent over the wire.  Code -32603 is JSON-RPC's \"Internal error\"."
  (acp-make-error :code -32603 :message message))

(cl-defun acp--call-request-failure (&key client incoming-response error-data message)
  "Invoke INCOMING-RESPONSE's failure callback with ERROR-DATA and MESSAGE."
  (with-temp-buffer ;; Fallback to a temp buffer
    (with-current-buffer (or (map-elt incoming-response :buffer)
                             (map-elt client :context-buffer)
                             (current-buffer))
      (let ((callback (map-elt incoming-response :on-failure)))
        (if (>= (cdr (func-arity callback)) 2)
            (funcall callback error-data message)
          (funcall callback error-data))))))

(cl-defun acp--fail-pending-requests (&key client event)
  "Invoke `:on-failure' for any pending requests on CLIENT.

EVENT is the sentinel event string describing why the process ended.
Each pending callback receives a synthetic JSON-RPC error matching the
shape used by `acp--route-incoming-message' for response failures."
  (let* ((pending (map-elt client :pending-requests))
         (trimmed (string-trim event))
         (error-message "Agent process ended before completing request")
         (error-data (acp--make-internal-error
                      (if (string-empty-p trimmed)
                          error-message
                        (format "%s: %s" error-message trimmed)))))
    (map-put! client :pending-requests nil)
    (dolist (entry pending)
      (when-let* ((incoming-response (cdr entry))
                  ((map-elt incoming-response :on-failure)))
        (condition-case-unless-debug err
            (acp--call-request-failure
             :client client
             :incoming-response incoming-response
             :error-data error-data
             :message (acp--make-message
                       :object `((jsonrpc . ,acp--jsonrpc-version)
                                 (id . ,(car entry))
                                 (error . ,error-data))
                       :json nil))
          (error
           (acp--log client "REQUEST FAILURE CALLBACK ERROR"
                     "Failed with error: %S" err)))))))

(cl-defun acp-subscribe-to-notifications (&key client on-notification buffer)
  "Subscribe to incoming CLIENT notifications.

ON-NOTIFICATION is of the form: (lambda (notification))

and invoked with BUFFER as current."
  (unless client
    (error ":client is required"))
  (unless on-notification
    (error ":on-notification is required"))
  (let ((handlers (map-elt client :notification-handlers)))
    (push (lambda (notification)
            (with-temp-buffer ;; Fallback to a temp buffer
              (with-current-buffer (or (when (buffer-live-p buffer)
                                         buffer)
                                       (when (buffer-live-p (map-elt client :context-buffer))
                                         (map-elt client :context-buffer))
                                       (current-buffer))
                (funcall on-notification notification))))
          handlers)
    (map-put! client :notification-handlers handlers)))

(cl-defun acp-subscribe-to-requests (&key client on-request buffer)
  "Subscribe to incoming CLIENT requests.

ON-REQUEST is of the form: (lambda (request))

and invoked with BUFFER as current."
  (unless client
    (error ":client is required"))
  (unless on-request
    (error ":on-request is required"))
  (let ((handlers (map-elt client :request-handlers)))
    (push (lambda (request)
            (with-temp-buffer ;; Fallback to a temp buffer
              (with-current-buffer (or (when (buffer-live-p buffer)
                                         buffer)
                                       (when (buffer-live-p (map-elt client :context-buffer))
                                         (map-elt client :context-buffer))
                                       (current-buffer))
                (funcall on-request request))))
          handlers)
    (map-put! client :request-handlers handlers)))

(cl-defun acp-subscribe-to-errors (&key client on-error buffer)
  "Subscribe to agent errors using CLIENT.

ON-ERROR is of the form: (lambda (error))

and invoked with BUFFER as current.

Note: These are agent process errors.
      For request errors refer to corresponding API's on-error."
  (unless client
    (error ":client is required"))
  (unless on-error
    (error ":on-error is required"))
  (let ((handlers (map-elt client :error-handlers)))
    (push (lambda (error)
            (with-temp-buffer ;; Fallback to a temp buffer
              (with-current-buffer (or (when (buffer-live-p buffer)
                                         buffer)
                                       (when (buffer-live-p (map-elt client :context-buffer))
                                         (map-elt client :context-buffer))
                                       (current-buffer))
                (funcall on-error error))))
          handlers)
    (map-put! client :error-handlers handlers)))

(cl-defun acp-shutdown (&key client)
  "Shutdown ACP CLIENT and release resources."
  (unless client
    (error ":client is required"))
  (if (and (or (not (map-elt client :process))
               (process-live-p (map-elt client :process)))
           (buffer-live-p (acp-logs-buffer :client client))
           (buffer-live-p (acp-traffic-buffer :client client)))
      (progn
        (when (process-live-p (map-elt client :process))
          (delete-process (map-elt client :process)))
        (kill-buffer (acp-logs-buffer :client client))
        (kill-buffer (acp-traffic-buffer :client client)))
    (message "Client already shut down")))

(cl-defun acp-send-request (&key client request buffer on-success on-failure sync)
  "Send REQUEST from CLIENT.

ON-SUCCESS is of the form (lambda (response)).
ON-FAILURE is of the form (lambda (error)).

When non-nil SYNC, send request synchronously.
When BUFFER is provided, callbacks executed within buffer context."
  (unless client
    (error ":client is required"))
  (unless request
    (error ":request is required"))
  (unless (acp--client-started-p client)
    (acp--start-client :client client))
  (funcall (map-elt client :request-sender)
           :client client
           :request request
           :buffer buffer
           :on-success on-success
           :on-failure on-failure
           :sync sync))

(cl-defun acp-send-notification (&key client notification sync)
  "Send NOTIFICATION from CLIENT.

When non-nil SYNC, send notification synchronously."
  (unless client
    (error ":client is required"))
  (unless notification
    (error ":notification is required"))
  (unless (acp--client-started-p client)
    (acp--start-client :client client))
  (funcall (map-elt client :notification-sender)
           :client client
           :notification notification
           :sync sync))

(cl-defun acp--request-sender (&key client request buffer on-success on-failure sync)
  "Send REQUEST from CLIENT.

ON-SUCCESS is of the form (lambda (response)).
ON-FAILURE is of the form (lambda (error)).
BUFFER: When non-nil, override CLIENT `:buffer-context' (see `acp-make-client').
SYNC: When non-nil, send request synchronously."
  (unless client
    (error ":client is required"))
  (unless request
    (error ":request is required"))
  (unless (acp--client-started-p client)
    (acp--start-client :client client))
  (when-let* ((decorator (map-elt client :outgoing-request-decorator)))
    (if-let* ((decorated (funcall decorator request)))
        (setq request decorated)
      (acp--log client "DECORATOR ERROR"
                "Outgoing request decorator returned nil for \"%s\", sending original request"
                (map-elt request :method))))
  (let* ((method (map-elt request :method))
         (params (map-elt request :params))
         (proc (map-elt client :process))
         (request-id (1+ (map-elt client :request-id)))
         (request `((jsonrpc . ,acp--jsonrpc-version)
                    (method . ,method)
                    (id . ,request-id)
                    ,@(when params `((params . ,params)))))
         (result nil)
         (done nil))
    (map-put! client :request-id request-id)
    (map-put! client :pending-requests
              (cons (cons request-id `((:request . ,request)
                                       (:buffer . ,buffer)
                                       (:on-success . ,on-success)
                                       (:on-failure . ,on-failure)))
                    (map-elt client :pending-requests)))
    (when sync
      (map-put! (map-nested-elt client `(:pending-requests ,request-id)) :on-success
                (lambda (data)
                  (setq result data
                        done t)))
      (map-put! (map-nested-elt client `(:pending-requests ,request-id)) :on-failure
                (lambda (data)
                  (setq result data
                        done 'error))))
    (acp--log client "OUTGOING OBJECT" "%s" request)
    (let ((json (acp--serialize-json request)))
      (acp--log client "OUTGOING TEXT" "%s" json)
      (acp--log-traffic client 'outgoing 'request (acp--make-message :object request :json json))
      (process-send-string proc json))
    (when sync
      (while (not done)
        (accept-process-output proc 0.01))
      (if (eq done 'error)
          (error "ACP request failed: %s" result)
        result))))

(cl-defun acp-send-response (&key client response)
  "Send a request RESPONSE from CLIENT."
  (unless client
    (error ":client is required"))
  (unless response
    (error ":response is required"))
  (funcall (map-elt client :response-sender)
           :client client
           :response response))

(cl-defun acp--response-sender (&key client response)
  "Send a request RESPONSE from CLIENT."
  (unless client
    (error ":client is required"))
  (unless response
    (error ":response is required"))
  (let* ((request-id (map-elt response :request-id))
         (result-data (map-elt response :result))
         (error-data (map-elt response :error)))
    (let* ((proc (map-elt client :process))
           (response (if error-data
                         `((jsonrpc . ,acp--jsonrpc-version)
                           (id . ,request-id)
                           (error . ,error-data))
                       `((jsonrpc . ,acp--jsonrpc-version)
                         (id . ,request-id)
                         (result . ,result-data)))))
      (let ((json (acp--serialize-json response)))
        (acp--log-traffic client 'outgoing 'response (acp--make-message :object response :json json))
        (process-send-string proc json)))))

(cl-defun acp--notification-sender (&key client notification sync)
  "Send NOTIFICATION from CLIENT.

ON-SUCCESS is of the form (lambda (response)).
ON-FAILURE is of the form (lambda (error)).

When non-nil SYNC, send notification synchronously."
  (unless client
    (error ":client is required"))
  (unless notification
    (error ":notification is required"))
  (unless (acp--client-started-p client)
    (acp--start-client :client client))
  (let* ((method (map-elt notification :method))
         (params (map-elt notification :params))
         (proc (map-elt client :process))
         (notification `((jsonrpc . ,acp--jsonrpc-version)
                         (method . ,method)
                         ,@(when params `((params . ,params)))))
         (result nil)
         (done nil))
    (acp--log client "OUTGOING OBJECT" "%s" notification)
    (let ((json (acp--serialize-json notification)))
      (acp--log client "OUTGOING TEXT" "%s" json)
      (acp--log-traffic client 'outgoing 'notification (acp--make-message :object notification :json json))
      (process-send-string proc json))
    (when sync
      (while (not done)
        (accept-process-output proc 0.01))
      (if (eq done 'error)
          (error "ACP notification failed: %s" result)
        result))))

(cl-defun acp-make-initialize-request (&key protocol-version
                                            client-info
                                            read-text-file-capability
                                            write-text-file-capability)
  "Instantiate an \"initialize\" request.

PROTOCOL-VERSION is the version of the ACP protocol to use.
CLIENT-INFO is an optional alist with client information containing
keys like `name', `title', and `version'.
READ-TEXT-FILE-CAPABILITY is a boolean indicating if the client
can read text files.
WRITE-TEXT-FILE-CAPABILITY is a boolean indicating if the client
can write text files.

See https://agentclientprotocol.com/protocol/schema#initializerequest
and https://agentclientprotocol.com/protocol/schema#initializeresponse."
  (unless protocol-version
    (error ":protocol-version is required"))
  `((:method . "initialize")
    (:params . (,@(when client-info
                    `((clientInfo . ,client-info)))
                (protocolVersion . ,protocol-version)
                (clientCapabilities . ((fs . ((readTextFile . ,(if read-text-file-capability
                                                                   t
                                                                 :false))
                                              (writeTextFile . ,(if write-text-file-capability
                                                                    t
                                                                  :false))))))))))

(cl-defun acp-make-authenticate-request (&key method-id method)
  "Instantiate an \"authenticate\" request.

METHOD-ID and METHOD (optionally) for authentication method to use.

See https://agentclientprotocol.com/protocol/schema#authenticaterequest."
  (unless method-id
    (error ":method-id is required"))
  `((:method . "authenticate")
    (:params . ,(append `((methodId . ,method-id))
                        (when method
                          `((authMethod . ,method)))))))

(cl-defun acp-make-session-new-request (&key cwd mcp-servers meta)
  "Instantiate a \"session/new\" request.

CWD is the current working directory for the session.
MCP-SERVERS is a list of MCP servers to use.
META is an optional alist of metadata to pass to the agent.
  Supported keys include:
  - `systemPrompt': Either a string (replaces default) or
    an alist with key `append' containing a string to append
    to the default system prompt.

See https://agentclientprotocol.com/protocol/schema#newsessionrequest
and https://agentclientprotocol.com/protocol/schema#newsessionresponse."
  (unless cwd
    (error ":cwd is required"))
  `((:method . "session/new")
    ;; directory-file-name removes any trailing /
    (:params . ((cwd . ,(directory-file-name (expand-file-name cwd)))
                (mcpServers . ,(or mcp-servers []))
                ,@(when meta `((_meta . ,meta)))))))

(cl-defun acp-make-session-prompt-request (&key session-id prompt)
  "Instantiate a \"session/prompt\" request.

SESSION-ID is the ID of the session to send the prompt to.
PROMPT is the prompt string.

See https://agentclientprotocol.com/protocol/schema#promptrequest
and https://agentclientprotocol.com/protocol/schema#promptresponse."
  (unless session-id
    (error ":session-id is required"))
  (unless prompt
    (error ":prompt is required"))
  `((:method . "session/prompt")
    (:params . ((sessionId . ,session-id)
                (prompt . ,(vconcat prompt))))))

(cl-defun acp-make-session-set-mode-request (&key session-id mode-id)
  "Instantiate a \"session/set_mode\" request.

SESSION-ID is the ID of the session to change the mode for.
MODE-ID is the mode to set (e.g., \"default\", \"plan\", \"acceptEdits\",
\"bypassPermissions\").

See https://agentclientprotocol.com/protocol/session-modes"
  (unless session-id
    (error ":session-id is required"))
  (unless mode-id
    (error ":mode-id is required"))
  `((:method . "session/set_mode")
    (:params . ((sessionId . ,session-id)
                (modeId . ,mode-id)))))

(cl-defun acp-make-session-set-model-request (&key session-id model-id)
  "Instantiate a \"session/set_model\" request.

SESSION-ID is the ID of the session to change the model for.
MODEL-ID is the model to set (e.g., \"default\", \"haiku\").

This is a claude-code-acp extension to the ACP protocol.

See https://docs.claude.com/en/api/agent-sdk/typescript"
  (unless session-id
    (error ":session-id is required"))
  (unless model-id
    (error ":model-id is required"))
  `((:method . "session/set_model")
    (:params . ((sessionId . ,session-id)
                (modelId . ,model-id)))))

(cl-defun acp-make-session-set-config-option-request (&key session-id config-id value)
  "Instantiate a \"session/set_config_option\" request.

SESSION-ID is the ID of the session to change the config option for.
CONFIG-ID is the id of the configuration option to change.
VALUE is the new value, must correspond to one of the option's values.

See https://agentclientprotocol.com/protocol/session-config-options"
  (unless session-id
    (error ":session-id is required"))
  (unless config-id
    (error ":config-id is required"))
  (unless value
    (error ":value is required"))
  `((:method . "session/set_config_option")
    (:params . ((sessionId . ,session-id)
                (configId . ,config-id)
                (value . ,value)))))

(cl-defun acp-make-session-resume-request (&key session-id cwd mcp-servers meta)
  "Instantiate a \"session/resume\" request.

SESSION-ID is the ID of the session to resume.
CWD is the current working directory for the resumed session.
MCP-SERVERS is an optional list of MCP servers to use.
META is an optional alist of metadata to pass to the agent.

This method resumes an existing session without returning previous messages
\(unlike `session/load').  Only available if the agent advertises the
`session.resume' capability.

Note: This is an unstable ACP feature.

See https://agentclientprotocol.com/rfds/session-resume."
  (unless session-id
    (error ":session-id is required"))
  (unless cwd
    (error ":cwd is required"))
  `((:method . "session/resume")
    (:params . ((sessionId . ,session-id)
                ;; directory-file-name removes any trailing /
                (cwd . ,(directory-file-name (expand-file-name cwd)))
                (mcpServers . ,(or mcp-servers []))
                ,@(when meta `((_meta . ,meta)))))))

(cl-defun acp-make-session-fork-request (&key session-id cwd mcp-servers meta)
  "Instantiate a \"session/fork\" request.

SESSION-ID is the ID of the session to fork from.
CWD is the current working directory for the forked session.
MCP-SERVERS is an optional list of MCP servers to use.
META is an optional alist of metadata to pass to the agent.

This method forks an existing session, creating a new session that
shares the conversation history of the original.  Only available if the
agent advertises the `session.fork' capability.

Note: This is an unstable ACP feature.

See https://agentclientprotocol.com/rfds/session-fork."
  (unless session-id
    (error ":session-id is required"))
  (unless cwd
    (error ":cwd is required"))
  `((:method . "session/fork")
    (:params . ((sessionId . ,session-id)
                ;; directory-file-name removes any trailing /
                (cwd . ,(directory-file-name (expand-file-name cwd)))
                (mcpServers . ,(or mcp-servers []))
                ,@(when meta `((_meta . ,meta)))))))

(cl-defun acp-make-session-list-request (&key cwd)
  "Instantiate a \"session/list\" request.

CWD is the current working directory used to filter sessions.

Note: This is an unstable ACP feature.

See https://agentclientprotocol.com/rfds/session-list."
  (unless cwd
    (error ":cwd is required"))
  `((:method . "session/list")
    ;; directory-file-name removes any trailing /
    (:params . ((cwd . ,(directory-file-name (expand-file-name cwd)))))))

(cl-defun acp-make-session-load-request (&key session-id cwd mcp-servers meta)
  "Instantiate a \"session/load\" request.

SESSION-ID is the ID of the session to load.
CWD is the current working directory for the loaded session.
MCP-SERVERS is an optional list of MCP servers to use.
META is an optional alist of metadata to pass to the agent.

See https://agentclientprotocol.com/protocol/schema#session-load."
  (unless session-id
    (error ":session-id is required"))
  (unless cwd
    (error ":cwd is required"))
  `((:method . "session/load")
    (:params . ((sessionId . ,session-id)
                ;; directory-file-name removes any trailing /
                (cwd . ,(directory-file-name (expand-file-name cwd)))
                (mcpServers . ,(or mcp-servers []))
                ,@(when meta `((_meta . ,meta)))))))

(cl-defun acp-make-session-delete-request (&key session-id)
  "Instantiate a \"session/delete\" request.

SESSION-ID is the ID of the session to delete.

Note: This is an unstable ACP feature.

See https://agentclientprotocol.com/rfds/session-delete."
  (unless session-id
    (error ":session-id is required"))
  `((:method . "session/delete")
    (:params . ((sessionId . ,session-id)))))

(cl-defun acp-make-session-request-permission-response (&key request-id option-id cancelled)
  "Instantiate a \"session/request_permission\" response.

REQUEST-ID is the ID of the request this is a response to.
OPTION-ID is the ID of the option selected by the user.
CANCELLED is non-nil if the response represents a cancelled request.

See https://agentclientprotocol.com/protocol/schema#requestpermissionresponse."
  (unless request-id
    (error ":request-id is required"))
  (when (and option-id cancelled)
    (error "Choose :option-id or :cancelled Not both"))
  (unless (or option-id cancelled)
    (error "Must specify either :option-id or :cancelled"))
  `((:request-id . ,request-id)
    (:result . ((outcome . ,(if cancelled
                                 '((outcome . "cancelled"))
                               `((outcome . "selected")
                                 (optionId . ,option-id))))))))

(cl-defun acp-make-fs-read-text-file-response (&key request-id content error)
  "Instantiate a \"fs/read_text_file\" response.

REQUEST-ID is the ID of the request this is a response to.
Provide either CONTENT (the file content as a string) or ERROR,
but not both.

See https://agentclientprotocol.com/protocol/schema#readtextfileresponse."
  (unless request-id
    (error ":request-id is required"))
  (cond
   ((and content error)
    (error "Either :content or :error but not both"))
   (error
    `((:request-id . ,request-id)
      (:error . ,error)))
   (content
    `((:request-id . ,request-id)
      (:result . ((content . ,content)))))
   (t
    (error "Either :content or :error is required"))))

(cl-defun acp-make-fs-write-text-file-response (&key request-id error)
  "Instantiate a \"fs/write_text_file\" response.

REQUEST-ID is the ID of the request this is a response to.
ERROR is an optional error object if the write operation failed.

See https://agentclientprotocol.com/protocol/schema#writetextfileresponse."
  (unless request-id
    (error ":request-id is required"))
  (if error
      `((:request-id . ,request-id)
        (:error . ,error))
    `((:request-id . ,request-id)
      (:result . nil))))

(cl-defun acp-make-error (&key code message data)
  "Create a JSON-RPC error object.

CODE is the error code.
MESSAGE is a string providing a short description of the error.
DATA is an optional value that contains additional information.

See https://www.jsonrpc.org/specification#error_object."
  (unless code
    (error ":code is required"))
  (unless message
    (error ":message is required"))
  (let ((error `((code . ,code)
                 (message . ,message))))
    (when data
      (nconc error `((data . ,data))))
    error))

(cl-defun acp-make-session-cancel-notification (&key session-id reason)
  "Instantiate a \"session/cancel\" request.

SESSION-ID is the ID of the session to cancel.
REASON is an optional string explaining the reason for cancellation.

See https://agentclientprotocol.com/protocol/schema#cancelnotification."
  (unless session-id
    (error ":session-id is required"))
  `((:method . "session/cancel")
    (:params . ((sessionId . ,session-id)
                ,@(when reason `((reason . ,reason)))))))

(cl-defun acp--request-resolver (&key client id)
  "Resolve CLIENT request with ID to a handler."
  (map-nested-elt client `(:pending-requests ,id)))

(cl-defun acp--make-message (&key json object)
  "Create message with JSON and OBJECT."
  (list (cons :object object)
        (cons :json json)))

(cl-defun acp--route-incoming-message (&key client message on-notification on-request)
  "Parse CLIENT's incoming MESSAGE with json/object and route accordingly.

ON-NOTIFICATION is of the form (lambda (notification))
ON-REQUEST is of the form (lambda (request))."
  (unless message
    (error ":object is required"))
  (unless on-notification
    (error ":on-notification is required"))
  (unless on-request
    (error ":on-request is required"))
  (let-alist (map-elt message :object)
    (or
     ;; Method request result (success)
     (when-let* ((incoming-response (and .id
                                         ;; Must check against key and not value because
                                         ;; nil result is valid also.
                                         (map-contains-key (map-elt message :object) 'result)
                                         (funcall (map-elt client :request-resolver)
                                                  :client client :id .id))))
       (acp--log client nil "↳ Routing as response (result)")
       (acp--log-traffic client 'incoming 'response message)
       (map-put! client :pending-requests (map-delete (map-elt client :pending-requests) .id))
       (if (map-elt incoming-response :on-success)
           (with-temp-buffer ;; Fallback to a temp buffer
             (with-current-buffer (or (map-elt incoming-response :buffer)
                                      (map-elt client :context-buffer)
                                      (current-buffer))
               (funcall (map-elt incoming-response :on-success) .result)))
         ;; TODO: Consolidate serialization.
         (acp--log client nil "Unhandled result:\n\n%s" message))
       t)

     ;; Method request result (failure)
     (when-let* ((incoming-response (and .error .id
                                         (funcall (map-elt client :request-resolver)
                                                  :client client :id .id))))
       (acp--log client nil "↳ Routing as response (error)")
       (acp--log-traffic client 'incoming 'response message)
       (map-put! client :pending-requests (map-delete (map-elt client :pending-requests) .id))
       (if (map-elt incoming-response :on-failure)
           (acp--call-request-failure
            :client client
            :incoming-response incoming-response
            :error-data .error
            :message message)
         (acp--log client nil "Unhandled error:\n\n%s" message))
       t)

     ;; Incoming method request
     (when (and .method .id)
       (acp--log client nil "↳ Routing as incoming request")
       (acp--log-traffic client 'incoming 'request message)
       (when on-request
         (funcall on-request (map-elt message :object)))
       t)

     ;; Incoming notification
     (when (not .id)
       (acp--log client nil "↳ Routing as notification")
       (acp--log-traffic client 'incoming 'notification message)
       (when on-notification
         (funcall on-notification (map-elt message :object)))
       t)

     ;; Unrecognized
     (when t
       (acp--log client nil "↳ Routing undefined (could not recognize)\n\n%s" (map-elt message :object))
       (acp--log-traffic client 'incoming 'unknown message)))))

(cl-defun acp--parse-stderr-api-error (raw-output)
  "Parse RAW-OUTPUT, typically from stderr.

Returns non-nil if error was parseable."
  (when (string-match "Attempt \\([0-9]+\\) failed with status \\([0-9]+\\)\\. Retrying.*ApiError: \\({.*}\\)" raw-output)
    (let ((error-json (match-string 3 raw-output)))
      (condition-case nil
          (let-alist (acp--parse-json error-json)
            ;; Parse the inner JSON from the message field and return just the error part
            (condition-case nil
                (map-elt (acp--parse-json .error.message) 'error)
              (error nil)))
        (error nil)))))

(defun acp--format-log-message (label format-string &rest args)
  "Return a log message formatted like `acp--log'.
LABEL, FORMAT-STRING, and ARGS are passed to `format'."
  (unless format-string
    (error ":format-string is required"))
  (let ((body (apply #'format format-string args)))
    (if label
        (format "%s >\n\n%s\n\n" label body)
      (format "%s\n\n" body))))

(defun acp--insert-log-entry (label format-string &rest args)
  "Insert a log message at point and add a boundary marker.
LABEL, FORMAT-STRING, and ARGS are passed to `format'."
  (let ((entry-start (point)))
    (insert (apply #'acp--format-log-message label format-string args))
    (when (< entry-start (point))
      (add-text-properties entry-start (1+ entry-start)
                           '(acp-log-boundary t)))))

(defun acp--log (client label format-string &rest args)
  "Log CLIENT message using LABEL, FORMAT-STRING, and ARGS."
  (when acp-logging-enabled
    (let ((log-buffer (acp-logs-buffer :client client)))
      (with-current-buffer log-buffer
        (goto-char (point-max))
        (apply #'acp--insert-log-entry label format-string args))
      (acp--trim-log-buffer log-buffer))))

(defvar acp--log-buffer-max-bytes (* 100 1000 1000)
  "Maximum size of the log buffer in bytes.")

(defun acp--total-buffer-bytes (buffer)
  "Return the total number of bytes in BUFFER."
  (with-current-buffer buffer
    (save-restriction
      (widen)
      (1- (position-bytes (point-max))))))

(defun acp--trim-log-buffer (buffer &optional max-bytes)
  "Trim BUFFER to a maximum size in bytes at log message boundaries.
MAX-BYTES defaults to `acp--log-buffer-max-bytes'."
  (when (buffer-live-p buffer)
    (with-current-buffer buffer
      (save-excursion
        (let ((max-bytes (or max-bytes acp--log-buffer-max-bytes))
              (total-bytes (acp--total-buffer-bytes (current-buffer))))
          (when (< max-bytes total-bytes)
            (goto-char (byte-to-position (- total-bytes max-bytes)))
            (when (get-text-property (point) 'acp-log-boundary)
              (forward-char 1))
            (delete-region (point-min)
                           (next-single-property-change
                            (point) 'acp-log-boundary nil (point-max)))))))))

(defun acp--json-pretty-print (json)
  "Return a pretty-printed JSON string."
  (if acp-logging-enabled
      (with-temp-buffer
        (insert json)
        (json-pretty-print (point-min) (point-max))
        (buffer-string))
    json))

(defun acp--log-traffic (client direction kind message)
  "Log CLIENT traffic MESSAGE to \"*acp traffic*\" buffer.
KIND may be `request', `response', or `notification'.
DIRECTION is either `incoming' or `outgoing', OBJECT is the parsed object."
  (when acp-logging-enabled
    (acp-traffic-log-traffic
     :buffer (acp-traffic-buffer :client client)
     :direction direction :kind kind :message message)))

(defun acp--show-json-object (object)
  "Display OBJECT in a pretty-printed buffer."
  (let ((json-buffer (get-buffer-create "*acp object*")))
    (with-current-buffer json-buffer
      (read-only-mode -1)
      (erase-buffer)
      (insert (json-encode object))
      (json-pretty-print-buffer)
      (goto-char (point-min))
      (read-only-mode 1))
    (display-buffer json-buffer)))

(cl-defun acp-reset-logs (&key client)
  "Reset CLIENT log buffers."
  (with-current-buffer (acp-logs-buffer :client client)
    (erase-buffer))
  (with-current-buffer (acp-traffic-buffer :client client)
    (erase-buffer)))

(cl-defun acp-logs-buffer (&key client)
  "Get CLIENT logs buffer."
  (if-let* ((name
             (format "*acp-(%s)-%s log*"
                     (map-elt client :command)
                     (map-elt client :instance-count)))
            (buffer (get-buffer name)))
      buffer
    (with-current-buffer (get-buffer-create name)
      (buffer-disable-undo)
      (current-buffer))))

(cl-defun acp-traffic-buffer (&key client)
  "Get CLIENT traffic buffer."
  (acp-traffic-get-buffer :named (format "*acp-(%s)-%s traffic*"
                                         (map-elt client :command)
                                         (map-elt client :instance-count))))

(defun acp--increment-instance-count ()
  "Increment variable `acp-instance-count'."
  (if (= acp-instance-count most-positive-fixnum)
      (setq acp-instance-count 0)
    (setq acp-instance-count (1+ acp-instance-count))))

(defun acp--parse-json (json)
  "Parse JSON using a consistent configuration."
  (json-parse-string json :object-type 'alist :null-object nil :false-object nil))

(defun acp--serialize-json (object)
  "Serialize OBJECT to JSON using a consistent configuration."
  (concat (json-serialize object) "\n"))

(provide 'acp)

;;; acp.el ends here
