;;; rail-tools.el --- RAIL MCP tools for RAIL.org -*- lexical-binding: t; -*-

;; Copyright (C) 2025

;; This file is NOT part of GNU Emacs.

;;; Commentary:

;; RAIL means "Rolling Action Item List".
;;
;; This file registers dedicated Emacs MCP tools for the RAIL skill so the
;; agent does not run raw `eval-elisp' snippets for each capture, status
;; change, log, result, or verification.  Each operation becomes a named tool.
;;
;; RAIL.org is a flat stream.  Each action item is a top-level heading, newest
;; first, tagged from a vocabulary that the file itself declares.  The file
;; holds no container heading.
;;
;; The tools carry no project vocabulary and no project workflow.  The stream
;; file owns both.  The `#+TODO:' line declares the status keywords.  The
;; `#+TAGS:' lines declare the tag vocabulary, grouped into axes.  The tools
;; read both from the file, so one tool file serves every project.
;;
;; Why dedicated tools instead of `eval-elisp'?
;;
;; The `eval-elisp' tool routes its argument through
;; `mcp-server-security-safe-eval', whose form walker blocks or prompts for
;; "dangerous" functions such as `find-file-noselect', `write-file', and
;; `save-buffer'.  With `mcp-server-security-prompt-for-permissions' set to t,
;; every RAIL snippet triggers a minibuffer prompt.
;;
;; A registered MCP tool runs through `mcp-server-tools-call', which calls the
;; handler function directly and does NOT pass through the form walker.  The
;; handlers below therefore run without the repeated security prompt.  Each
;; tool also carries MCP `annotations' so the MCP client can auto-approve the
;; read-only tools.
;;
;; The tools operate only on the file "RAIL.org".  They find that file
;; under `rail-project-root', or under a caller-supplied project ROOT that
;; overrides it.  They never touch any other file.
;;
;; `rail-project-root' comes from an upward search for the stream file.  The
;; search starts at this file's own directory, then at `default-directory'.  It
;; assumes no directory layout, so this file needs no absolute path and it
;; works on every machine.
;;
;; Install the tools once per Emacs session.  Load this file, and the tools
;; register themselves.  With `mcp-server-emacs-tools-enabled' set to `all',
;; which is the default, they appear in the MCP tool list at once.
;;
;; The MCP framework is a soft dependency.  When the framework is absent, for
;; example in a batch test run, this file still loads and every handler stays
;; callable.  Run the test suite with the run-tests.sh script beside this file.

;;; Code:

(require 'cl-lib)
(require 'org)
(require 'org-id)
(require 'json)
(require 'subr-x)

;; Load the MCP tool framework when it is available.  When it is absent, for
;; example in a batch test run, define the two symbols the registrations below
;; need and discard each registration.  The handler functions stay callable, so
;; the test suite runs on any machine without the framework.
(defconst rail-mcp-available (require 'mcp-server-tools nil t)
  "Non-nil when the Emacs MCP tool framework is available.")

(unless rail-mcp-available
  ;; Define plain functions, never a struct.  A stub struct would clobber the
  ;; real slot layout if the framework loads later in the same session.
  (defun make-mcp-server-tool (&rest _args)
    "Return nil.  The MCP framework is absent."
    nil)
  (defun mcp-server-register-tool (_tool)
    "Discard _TOOL.  The MCP framework is absent."
    nil))

(defvar rail-stream-file-name "RAIL.org"
  "Name of the Org file that RAIL manages.")

(defvar rail-tools-path
  (let ((file (or load-file-name buffer-file-name)))
    (and file (expand-file-name file)))
  "Absolute path of this file, or nil when the path is unknown.")

(defun rail-locate-root (start)
  "Return the closest directory at or above START that holds the stream file.
The stream file is `rail-stream-file-name'.  Return nil when no
ancestor directory holds that file."
  (let ((dir (and start (locate-dominating-file
                         (file-name-as-directory (expand-file-name start))
                         rail-stream-file-name))))
    (and dir (expand-file-name (file-name-as-directory dir)))))

(defvar rail-project-root
  (or (rail-locate-root (and rail-tools-path
                               (file-name-directory rail-tools-path)))
      (rail-locate-root default-directory)
      (expand-file-name default-directory))
  "Default project directory that holds the RAIL stream file.
The value comes from an upward search for `rail-stream-file-name',
first from this file's own directory, then from `default-directory'.
The search makes no assumption about the depth of this file in the
project.  Set this variable to override the search, or pass a `root'
argument to any tool.")

;;; Helpers

(defun rail-tools--file (args)
  "Return the absolute path of the stream file for ARGS.
ARGS may hold a `root' string that names the project directory.  When
`root' is absent, use `rail-project-root'.  Signal an error when the
selected root is not a directory."
  (let ((root (or (alist-get 'root args) rail-project-root)))
    (unless (and (stringp root) (> (length root) 0))
      (error "No project root: pass `root' or set `rail-project-root'"))
    (let ((dir (expand-file-name root)))
      (unless (file-directory-p dir)
        (error "Not a directory: %s" dir))
      (expand-file-name rail-stream-file-name dir))))

(defun rail-tools--buffer (file)
  "Return an org-mode buffer visiting FILE, creating it as needed."
  (let ((buf (find-file-noselect file)))
    (with-current-buffer buf
      (unless (derived-mode-p 'org-mode)
        (org-mode)))
    buf))

(defun rail-tools--goto-id (id)
  "Move point to the heading with Org ID in the current buffer.
Signal an error when ID is not found."
  (let ((marker (org-id-find id 'marker)))
    (unless marker
      (error "Org ID not found: %s" id))
    (goto-char marker)))

(defun rail-tools--fill-body ()
  "Wrap the body of the entry at point to 72 columns.
Fill every paragraph after the metadata (SCHEDULED line, property
drawer) up to the next heading.  Use `org-fill-paragraph' so Org
list items and other structure fill correctly.  Point must be on
the entry heading."
  (let ((fill-column 72))
    (org-back-to-heading t)
    (let ((end (save-excursion (org-end-of-subtree t t) (point-marker))))
      ;; Move past the heading and all metadata (planning line,
      ;; property drawer, logbook) to the first line of body text.
      (org-end-of-meta-data t)
      ;; Fill each body line.  `org-fill-paragraph' fills the whole
      ;; element and is idempotent, so stepping one line at a time is
      ;; safe and does not overshoot a trailing paragraph.
      (while (< (point) end)
        (unless (looking-at-p "^[ \t]*$")
          (org-fill-paragraph))
        (forward-line 1))
      (set-marker end nil))))

(defun rail-tools--nonblank (value)
  "Return VALUE trimmed when it is a non-blank string, else nil."
  (and (stringp value)
       (let ((trimmed (string-trim value)))
         (and (> (length trimmed) 0) trimmed))))

(defconst rail-tools--closing-labels
  '((done      . "CLOSING NOTE")
    (blocked   . "BLOCKED NOTE")
    (cancelled . "CANCELLED NOTE"))
  "Map a closing purpose to its `:LOGBOOK:' note label.
The label mirrors Org's own `CLOSING NOTE' heading for the `done'
purpose, so a RAIL closing note reads like a native Org log note.")

(defun rail-tools--drawer-insert (line &optional nofill)
  "Insert LINE as the newest item in the entry's `:LOGBOOK:' drawer.
Create the drawer directly after the metadata when it is absent.  LINE
is one already-formatted list item without its leading dash.  Wrap the
inserted item to 72 columns, unless NOFILL is non-nil, in which case
keep it on one line.  This never edits an existing item or the body.
Point must be on the entry heading."
  (let ((fill-column 72))
    (org-back-to-heading t)
    (let ((subtree-end (save-excursion (org-end-of-subtree t t) (point-marker))))
      (org-back-to-heading t)
      (let ((drawer-start
             (save-excursion
               (when (re-search-forward "^[ \t]*:LOGBOOK:[ \t]*$" subtree-end t)
                 (line-beginning-position)))))
        (unless drawer-start
          (org-end-of-meta-data t)
          (insert ":LOGBOOK:\n:END:\n")
          (setq drawer-start
                (save-excursion
                  (org-back-to-heading t)
                  (re-search-forward "^[ \t]*:LOGBOOK:[ \t]*$" subtree-end t)
                  (line-beginning-position))))
        (goto-char drawer-start)
        (forward-line 1)
        (let ((item-start (point)))
          (insert (format "- %s\n" line))
          (unless nofill
            (save-excursion
              (goto-char item-start)
              (org-fill-paragraph)))))
      (set-marker subtree-end nil))))

(defun rail-tools--append-log (note)
  "Append NOTE as a timestamped item to the entry's `:LOGBOOK:' drawer.
Insert the newest item first and wrap it to 72 columns.  This is
append-only.  It never edits an existing item or the body.  Point must
be on the entry heading."
  (let ((ts (format-time-string "[%Y-%m-%d %a %H:%M]")))
    (rail-tools--drawer-insert (format "%s %s" ts note))))

(defun rail-tools--closing-note-text (commit tests &optional model notes)
  "Compose the closing-note text for a completed item.
COMMIT is a commit hash.  TESTS is a short recap such as \"215 pass\".
MODEL names the agent that did the work, and NOTES adds a free-text
tail after a semicolon.  Both are optional.  Return one line, because
the reader reads one line."
  (let ((model (rail-tools--nonblank model))
        (notes (rail-tools--nonblank notes)))
    (concat (if model (format "model=%s " model) "")
            (format "commit=%s tests=%s" commit tests)
            (if notes (format "; %s" notes) ""))))

(defun rail-tools--append-closing-note (purpose text)
  "Write a closing note into the entry's `:LOGBOOK:' drawer.
PURPOSE is `done', `blocked', or `cancelled'.  TEXT is the note body.
The note reads `LABEL [timestamp] :: TEXT', with LABEL from
`rail-tools--closing-labels'.  It lands in the drawer next to the
state timestamp, and it replaces the old body-line evidence.  When the
entry already carries a note of the same PURPOSE, replace that note in
place, so a re-run does not stack a second note.  Point must be on the
entry heading."
  (let ((label (or (cdr (assq purpose rail-tools--closing-labels))
                   (error "Unknown closing purpose: %s" purpose)))
        (ts (format-time-string "[%Y-%m-%d %a %H:%M]")))
    (org-back-to-heading t)
    (let ((subtree-end (save-excursion (org-end-of-subtree t t) (point-marker)))
          (line (format "%s %s :: %s" label ts text)))
      (org-back-to-heading t)
      (if (re-search-forward
           (format "^[ \t]*- %s \\[[^]]*\\] ::.*$" (regexp-quote label))
           subtree-end t)
          ;; Replace an existing note of this purpose in place.  Keep the
          ;; note on one line, because the reader reads one line.
          (replace-match (format "- %s" line) t t)
        (rail-tools--drawer-insert line 'nofill))
      (set-marker subtree-end nil))))

(defun rail-tools--closing-note-of (purpose)
  "Return the text of the newest closing note of PURPOSE at point.
PURPOSE is `done', `blocked', or `cancelled'.  Return nil when the
entry carries no such note.  Point must be on the entry heading."
  (let ((label (cdr (assq purpose rail-tools--closing-labels))))
    (org-back-to-heading t)
    (let ((subtree-end (save-excursion (org-end-of-subtree t t) (point))))
      (org-back-to-heading t)
      (when (re-search-forward
             (format "^[ \t]*- %s \\[[^]]*\\] :: \\(.*\\)$"
                     (regexp-quote label))
             subtree-end t)
        (string-trim (match-string-no-properties 1))))))

(defmacro rail-tools--json (&rest body)
  "Evaluate BODY and return its value as a JSON string.
Catch any error and return a JSON object with an `error' field."
  (declare (indent 0))
  `(condition-case err
       (json-encode (progn ,@body))
     (error (json-encode `((error . ,(error-message-string err)))))))

;;; Tag vocabulary

;; The vocabulary is not hardcoded.  Each stream file declares it with
;; `#+TAGS:' group-tag lines, for example:
;;
;;   #+TAGS: [ Kind : feat fix chore ]
;;   #+TAGS: [ Scope : core web ]
;;
;; Org parses those lines into `org-current-tag-alist'.  The functions below
;; read that alist, so the vocabulary follows the file, not this code.  A file
;; with no `#+TAGS:' line accepts any tag.

(defun rail-tools--tag-axes ()
  "Return the tag vocabulary of the current buffer, grouped by axis.
Read the group tags that Org parsed from the `#+TAGS:' lines into
`org-current-tag-alist'.  Return an alist that maps each axis symbol to
its list of tag strings.  Return nil when the file declares no axis, and
then the file accepts any tag."
  (let ((axes '()) (current nil))
    (dolist (entry org-current-tag-alist)
      (pcase entry
        (`(:startgrouptag) (setq current nil))
        (`(:endgrouptag)
         (when current
           (push (cons (intern (downcase (car current)))
                       (nreverse (cdr current)))
                 axes))
         (setq current nil))
        (`(:grouptags))
        (`(,(and tag (pred stringp)) . ,_)
         (if current
             (setcdr current (cons tag (cdr current)))
           ;; The first tag in a group is the axis name.
           (setq current (cons tag '()))))))
    (nreverse axes)))

(defun rail-tools--all-tags ()
  "Return every tag the current buffer declares, as one flat list.
Return nil when the file declares no vocabulary."
  (apply #'append (mapcar #'cdr (rail-tools--tag-axes))))

(defun rail-tools--check-tags (tags)
  "Signal an error when TAGS holds a tag outside the file vocabulary.
TAGS is a list of strings.  When the file declares no vocabulary, accept
any tag.  Return TAGS unchanged when valid."
  (let ((allowed (rail-tools--all-tags)))
    (when allowed
      (dolist (tag tags)
        (unless (member tag allowed)
          (error "Unknown tag `%s'; allowed: %s"
                 tag (string-join allowed ", "))))))
  tags)

(defun rail-tools--goto-stream-top ()
  "Move point to the insertion place for a new item.
That place is the start of the first top-level heading, after the
file preamble.  When no heading exists, move to the end of the
preamble."
  (goto-char (point-min))
  (if (re-search-forward "^\\* " nil t)
      (goto-char (line-beginning-position))
    (goto-char (point-max))))

;;; inspect (read-only)

(defun rail-tools--inspect-handler (args)
  "Report the TODO sequence and the tag vocabulary for RAIL.org.
Read both from the stream file, so the report mirrors the file."
  (rail-tools--json
    (let ((file (rail-tools--file args)))
      (with-current-buffer (rail-tools--buffer file)
        (org-with-wide-buffer
         `((file . ,file)
           (todo_keywords . ,(vconcat org-todo-keywords-1))
           (tags . ,(mapcar (lambda (axis)
                              (cons (car axis) (vconcat (cdr axis))))
                            (rail-tools--tag-axes)))))))))

(mcp-server-register-tool
 (make-mcp-server-tool
  :name "rail-inspect"
  :title "RAIL Inspect"
  :description "Inspect RAIL.org: return its TODO keyword sequence and the tag vocabulary that the file declares, grouped by axis.  Read-only."
  :input-schema '((type . "object")
                  (properties . ((root . ((type . "string")
                                          (description . "Absolute path to the project directory containing RAIL.org")))))
                  (required . []))
  :function #'rail-tools--inspect-handler
  :annotations '((readOnlyHint . t)
                 (destructiveHint . :false)
                 (idempotentHint . t)
                 (openWorldHint . :false))))

;;; list (read-only)

(defun rail-tools--list-handler (args)
  "List the top-level action items in RAIL.org, newest first.
ARGS keys: `root', `state' (optional), `tag' (optional).  When STATE is
given, return only items with that TODO keyword.  When TAG is given,
return only items that carry that tag.  Each row has `id', `title',
`state', `scheduled', and `tags'."
  (rail-tools--json
    (let ((file  (rail-tools--file args))
          (state (alist-get 'state args))
          (tag   (alist-get 'tag args)))
      (with-current-buffer (rail-tools--buffer file)
        (org-with-wide-buffer
         (goto-char (point-min))
         (let ((rows '()))
           (while (re-search-forward "^\\* " nil t)
             (let ((todo (org-get-todo-state))
                   (tags (org-get-tags nil t)))
               (when (and (or (null state) (equal state todo))
                          (or (null tag) (member tag tags)))
                 (push `((id . ,(org-id-get))
                         (title . ,(org-get-heading t t t t))
                         (state . ,todo)
                         (scheduled . ,(org-entry-get nil "SCHEDULED"))
                         (tags . ,(vconcat tags)))
                       rows))))
           ;; The file is newest-first, so reverse to keep that order.
           (vconcat (nreverse rows))))))))

(mcp-server-register-tool
 (make-mcp-server-tool
  :name "rail-list"
  :title "RAIL List"
  :description "List the top-level action items in RAIL.org, newest first, with each entry's Org ID, title, TODO state, SCHEDULED time, and tags.  Pass an optional `state' or `tag' to filter.  Read-only."
  :input-schema '((type . "object")
                  (properties . ((root . ((type . "string")
                                          (description . "Absolute path to the project directory")))
                                 (state . ((type . "string")
                                           (description . "Optional TODO keyword filter, for example TODO or IN-PROGRESS")))
                                 (tag . ((type . "string")
                                         (description . "Optional tag filter, for example web or major")))))
                  (required . []))
  :function #'rail-tools--list-handler
  :annotations '((readOnlyHint . t)
                 (destructiveHint . :false)
                 (idempotentHint . t)
                 (openWorldHint . :false))))

;;; capture

(defun rail-tools--capture-handler (args)
  "Capture a TODO entry at the top of the RAIL.org stream.
ARGS keys: `root', `title', `body' (optional), `tags' (optional array).
Insert the entry as a top-level heading directly below the file
preamble, so the newest item is first.  Record the capture time as an
inactive SCHEDULED timestamp, apply TAGS from the file vocabulary,
assign an Org ID, and wrap the body to 72 columns."
  (rail-tools--json
    (let* ((file  (rail-tools--file args))
           (title (or (alist-get 'title args) (error "Missing `title'")))
           (body  (or (alist-get 'body args) ""))
           (raw-tags (append (alist-get 'tags args) nil))
           (captured-at (format-time-string "[%Y-%m-%d %a %H:%M]")))
      (with-current-buffer (rail-tools--buffer file)
        (org-with-wide-buffer
         ;; Validate inside the buffer, because the vocabulary lives here.
         (let ((tags (rail-tools--check-tags raw-tags)))
           (rail-tools--goto-stream-top)
           (let ((start (point)))
             (insert (format "* TODO %s\nSCHEDULED: %s\n" title captured-at))
             (unless (string-empty-p body)
               (insert body "\n"))
             (goto-char start)
             (when tags
               (org-set-tags tags))
             (let ((id (org-id-get-create)))
               (rail-tools--fill-body)
               (when (buffer-modified-p) (save-buffer))
               (goto-char (org-id-find id 'marker))
               `((id . ,id)
                 (file . ,file)
                 (heading . ,(org-get-heading t t t t))
                 (tags . ,(vconcat (org-get-tags nil t))))))))))))

(mcp-server-register-tool
 (make-mcp-server-tool
  :name "rail-capture"
  :title "RAIL Capture"
  :description "Capture a TODO action item as a top-level heading at the top of RAIL.org, so the newest item comes first.  Applies tags that the file vocabulary permits, records the capture time as an inactive SCHEDULED timestamp, wraps the body to 72 columns, and assigns an Org ID."
  :input-schema '((type . "object")
                  (properties . ((root . ((type . "string")
                                          (description . "Absolute path to the project directory")))
                                 (title . ((type . "string")
                                           (description . "Imperative title under 60 chars")))
                                 (body . ((type . "string")
                                          (description . "Full request text, verbatim")))
                                 (tags . ((type . "array")
                                          (items . ((type . "string")))
                                          (description . "Tags from the vocabulary that the file declares in its #+TAGS: lines. Run rail-inspect to read the axes and their allowed tags.")))))
                  (required . ["title"]))
  :function #'rail-tools--capture-handler
  :annotations '((readOnlyHint . :false)
                 (destructiveHint . :false)
                 (idempotentHint . :false)
                 (openWorldHint . :false))))

;;; set-status

(defun rail-tools--set-status-handler (args)
  "Change the TODO keyword of an entry.
ARGS keys: `root', `id', `state'.  STATE must be one keyword from the
file's own #+TODO sequence, and must not be DONE (use rail-complete)."
  (rail-tools--json
    (let ((file  (rail-tools--file args))
          (id    (or (alist-get 'id args) (error "Missing `id'")))
          (state (or (alist-get 'state args) (error "Missing `state'"))))
      (when (string-equal state "DONE")
        (error "Use rail-complete for DONE, not rail-set-status"))
      (with-current-buffer (rail-tools--buffer file)
        (rail-tools--goto-id id)
        (org-todo state)
        (when (buffer-modified-p) (save-buffer))
        `((id . ,id)
          (state . ,(org-get-todo-state)))))))

(mcp-server-register-tool
 (make-mcp-server-tool
  :name "rail-set-status"
  :title "RAIL Set Status"
  :description "Set the TODO keyword of a RAIL entry to any open keyword from the file's own #+TODO sequence.  Does not accept DONE; use rail-complete for that."
  :input-schema '((type . "object")
                  (properties . ((root . ((type . "string")))
                                 (id . ((type . "string")
                                        (description . "Org ID of the entry")))
                                 (state . ((type . "string")
                                           (description . "TODO keyword from the file's #+TODO sequence")))))
                  (required . ["id" "state"]))
  :function #'rail-tools--set-status-handler
  :annotations '((readOnlyHint . :false)
                 (destructiveHint . :false)
                 (idempotentHint . t)
                 (openWorldHint . :false))))

;;; log

(defun rail-tools--log-handler (args)
  "Append a timestamped note to an entry's `:LOGBOOK:' drawer.
ARGS keys: `root', `id', `note'.  Append-only progress feedback from an
agentic session.  Never edits an existing note or the item body."
  (rail-tools--json
    (let ((file (rail-tools--file args))
          (id   (or (alist-get 'id args) (error "Missing `id'")))
          (note (or (alist-get 'note args) (error "Missing `note'"))))
      (with-current-buffer (rail-tools--buffer file)
        (rail-tools--goto-id id)
        (rail-tools--append-log note)
        (when (buffer-modified-p) (save-buffer))
        `((id . ,id)
          (state . ,(org-get-todo-state)))))))

(mcp-server-register-tool
 (make-mcp-server-tool
  :name "rail-log"
  :title "RAIL Log"
  :description "Append a timestamped progress note to a RAIL entry's `:LOGBOOK:' drawer.  The drawer is append-only.  The tool never rewrites an earlier note, and never rewrites the item body.  Newest note first, wrapped to 72 columns."
  :input-schema '((type . "object")
                  (properties . ((root . ((type . "string")))
                                 (id . ((type . "string")
                                        (description . "Org ID of the entry")))
                                 (note . ((type . "string")
                                          (description . "Progress note to append")))))
                  (required . ["id" "note"]))
  :function #'rail-tools--log-handler
  :annotations '((readOnlyHint . :false)
                 (destructiveHint . :false)
                 (idempotentHint . :false)
                 (openWorldHint . :false))))

;;; set-result

(defun rail-tools--set-result-handler (args)
  "Write the DONE closing note for an entry without changing its state.
ARGS keys: `root', `id', `commit', `tests', `model' (optional),
`notes' (optional).  COMMIT is a commit hash.  TESTS is a short recap
such as \"215 pass\".  Compose the note text and write it as a
`CLOSING NOTE' item in the `:LOGBOOK:' drawer, replacing an earlier
one.  Use this to pre-stage the closing evidence before rail-complete."
  (rail-tools--json
    (let ((file   (rail-tools--file args))
          (id     (or (alist-get 'id args) (error "Missing `id'")))
          (commit (or (alist-get 'commit args) (error "Missing `commit'")))
          (tests  (or (alist-get 'tests args) (error "Missing `tests'")))
          (model  (alist-get 'model args))
          (notes  (alist-get 'notes args)))
      (with-current-buffer (rail-tools--buffer file)
        (rail-tools--goto-id id)
        (rail-tools--append-closing-note
         'done (rail-tools--closing-note-text commit tests model notes))
        (when (buffer-modified-p) (save-buffer))
        (rail-tools--goto-id id)
        `((id . ,id)
          (result . ,(rail-tools--result-text)))))))

(mcp-server-register-tool
 (make-mcp-server-tool
  :name "rail-set-result"
  :title "RAIL Set Result"
  :description "Write the DONE closing note for a RAIL entry into the :LOGBOOK: drawer, recording the commit hash, a short test recap, and optionally the model that did the work and a free-text note.  Replaces an earlier closing note.  Use it to pre-stage the closing evidence; rail-complete writes the same note when it closes the item."
  :input-schema '((type . "object")
                  (properties . ((root . ((type . "string")))
                                 (id . ((type . "string")
                                        (description . "Org ID of the entry")))
                                 (commit . ((type . "string")
                                            (description . "Commit hash")))
                                 (tests . ((type . "string")
                                           (description . "Short test recap, for example \"215 pass\"")))
                                 (model . ((type . "string")
                                           (description . "Optional model or agent that did the work, for example the agent name")))
                                 (notes . ((type . "string")
                                           (description . "Optional free-text tail appended after a semicolon, for example a root cause")))))
                  (required . ["id" "commit" "tests"]))
  :function #'rail-tools--set-result-handler
  :annotations '((readOnlyHint . :false)
                 (destructiveHint . :false)
                 (idempotentHint . t)
                 (openWorldHint . :false))))

;;; check (checklist for sub-tasks)

(defconst rail-tools--checklist-header "Checklist [/]:"
  "Header line that introduces an item's checkbox list.
The `[/]' cookie tracks completed items against the total.")

(defun rail-tools--checklist-add (item)
  "Add ITEM as an unchecked checkbox to the entry at point.
Create the checklist block when it does not exist.  Wrap ITEM to 72
columns and refresh the `[/]' cookie.  Point must be on the heading."
  (let ((fill-column 72))
    (org-back-to-heading t)
    (let* ((subtree-end (save-excursion (org-end-of-subtree t t) (point-marker)))
           (line (format "- [ ] %s\n" item))
           insert-at)
      (org-back-to-heading t)
      (if (re-search-forward "^Checklist \\[[0-9]*/[0-9]*\\]:[ \t]*$"
                             subtree-end t)
          ;; Existing block: step past the trailing checkbox items.
          (progn (forward-line 1)
                 (while (looking-at-p "^- \\[.\\] \\|^  ") (forward-line 1))
                 (setq insert-at (point))
                 (insert line))
        ;; No block: append one at the end of the body.
        (goto-char subtree-end)
        (skip-chars-backward "\n")
        (insert "\n\n" rail-tools--checklist-header "\n")
        (setq insert-at (point))
        (insert line))
      (save-excursion (goto-char insert-at) (org-fill-paragraph))
      (org-update-checkbox-count)
      (set-marker subtree-end nil))))

(defun rail-tools--checklist-toggle (item)
  "Toggle the checkbox whose text matches ITEM in the entry at point.
Signal an error when no item matches.  Refresh the `[/]' cookie.
Point must be on the heading."
  (org-back-to-heading t)
  (let ((subtree-end (save-excursion (org-end-of-subtree t t) (point-marker))))
    (org-back-to-heading t)
    (if (re-search-forward (concat "^- \\[.\\] " (regexp-quote item))
                           subtree-end t)
        (progn (beginning-of-line) (org-toggle-checkbox)
               (org-update-checkbox-count))
      (set-marker subtree-end nil)
      (error "No checklist item matches: %s" item))
    (set-marker subtree-end nil)))

(defun rail-tools--checklist-items ()
  "Return the checklist items of the entry at point.
Each item is an alist with `done' and `text'.  Point must be on the
heading."
  (org-back-to-heading t)
  (let ((subtree-end (save-excursion (org-end-of-subtree t t) (point)))
        (items '()))
    (org-back-to-heading t)
    (while (re-search-forward "^- \\[\\(.\\)\\] \\(.*\\)$" subtree-end t)
      (push `((done . ,(if (string-equal (match-string 1) " ") :json-false t))
              (text . ,(string-trim (match-string-no-properties 2))))
            items))
    (vconcat (nreverse items))))

(defun rail-tools--check-handler (args)
  "Manage the checklist of an item, for splitting a complex task.
ARGS keys: `root', `id', `action' (add|toggle|list), `item'.
`add' appends an unchecked item.  `toggle' flips a matching item.
`list' returns the items.  A `[/]' cookie tracks progress."
  (rail-tools--json
    (let ((file   (rail-tools--file args))
          (id     (or (alist-get 'id args) (error "Missing `id'")))
          (action (or (alist-get 'action args) (error "Missing `action'")))
          (item   (alist-get 'item args)))
      (with-current-buffer (rail-tools--buffer file)
        (rail-tools--goto-id id)
        (cond
         ((string-equal action "add")
          (unless item (error "`add' needs an `item'"))
          (rail-tools--checklist-add item))
         ((string-equal action "toggle")
          (unless item (error "`toggle' needs an `item'"))
          (rail-tools--checklist-toggle item))
         ((string-equal action "list") nil)
         (t (error "Unknown action `%s'; use add, toggle, or list" action)))
        (when (buffer-modified-p) (save-buffer))
        (rail-tools--goto-id id)
        `((id . ,id)
          (items . ,(rail-tools--checklist-items)))))))

(mcp-server-register-tool
 (make-mcp-server-tool
  :name "rail-check"
  :title "RAIL Checklist"
  :description "Manage an item's checkbox list to split a complex task into sub-tasks with their own done state.  Actions: add an unchecked item, toggle a matching item, or list items.  A [/] cookie on the checklist header tracks progress.  The items stay inside the one request.  They are not separate stream entries."
  :input-schema '((type . "object")
                  (properties . ((root . ((type . "string")))
                                 (id . ((type . "string")
                                        (description . "Org ID of the item")))
                                 (action . ((type . "string")
                                            (description . "add, toggle, or list")))
                                 (item . ((type . "string")
                                          (description . "Item text for add or toggle")))))
                  (required . ["id" "action"]))
  :function #'rail-tools--check-handler
  :annotations '((readOnlyHint . :false)
                 (destructiveHint . :false)
                 (idempotentHint . :false)
                 (openWorldHint . :false))))

;;; show (read-only)

(defun rail-tools--body-text ()
  "Return the plain body text of the entry at point.
Read from the first line after the metadata up to the first of: a
`Checklist [' line or the end of the subtree.  The closing note lives
in the `:LOGBOOK:' drawer, not the body, so it never appears here.
Return the trimmed string.  Point must be on the entry heading."
  (org-back-to-heading t)
  (let ((subtree-end (save-excursion (org-end-of-subtree t t) (point))))
    (org-back-to-heading t)
    (org-end-of-meta-data t)
    (let ((body-start (point))
          (body-end subtree-end))
      (save-excursion
        (goto-char body-start)
        (when (re-search-forward "^Checklist \\[" subtree-end t)
          (setq body-end (line-beginning-position))))
      (string-trim
       (buffer-substring-no-properties body-start body-end)))))

(defun rail-tools--logbook-items ()
  "Return the `:LOGBOOK:' drawer item lines of the entry at point.
Each item is a string, in the order stored (newest first).  Return an
empty vector when there is no drawer.  Point must be on the heading."
  (org-back-to-heading t)
  (let ((subtree-end (save-excursion (org-end-of-subtree t t) (point)))
        (items '()))
    (org-back-to-heading t)
    (when (re-search-forward "^[ \t]*:LOGBOOK:[ \t]*$" subtree-end t)
      (forward-line 1)
      (while (and (< (point) subtree-end)
                  (not (looking-at-p "^[ \t]*:END:[ \t]*$")))
        (when (looking-at "^[ \t]*- \\(.*\\)$")
          (push (string-trim (match-string-no-properties 1)) items))
        (forward-line 1)))
    (vconcat (nreverse items))))

(defun rail-tools--result-text ()
  "Return the text of the entry's DONE closing note.
Read the newest `CLOSING NOTE' item from the `:LOGBOOK:' drawer.
Return nil when there is no such note, so it encodes as JSON null.
Point must be on the heading."
  (rail-tools--closing-note-of 'done))

(defun rail-tools--show-handler (args)
  "Return the full content of an entry.
ARGS keys: `root', `id'.  Report the heading, state, tags, scheduled
and closed timestamps, body text, logbook notes, checklist items, and
the DONE closing note.  Read-only."
  (rail-tools--json
    (let ((file (rail-tools--file args))
          (id   (or (alist-get 'id args) (error "Missing `id'"))))
      (with-current-buffer (rail-tools--buffer file)
        (org-with-wide-buffer
         (rail-tools--goto-id id)
         `((id . ,id)
           (heading . ,(org-get-heading t t t t))
           (state . ,(org-get-todo-state))
           (tags . ,(vconcat (org-get-tags nil t)))
           (scheduled . ,(org-entry-get nil "SCHEDULED"))
           (closed . ,(org-entry-get nil "CLOSED"))
           (body . ,(rail-tools--body-text))
           (logbook . ,(rail-tools--logbook-items))
           (checklist . ,(rail-tools--checklist-items))
           (result . ,(rail-tools--result-text))))))))

(mcp-server-register-tool
 (make-mcp-server-tool
  :name "rail-show"
  :title "RAIL Show"
  :description "Return the full content of a RAIL entry: heading, state, tags, scheduled and closed timestamps, body text, logbook notes, checklist items, and the DONE closing note.  Read-only."
  :input-schema '((type . "object")
                  (properties . ((root . ((type . "string")))
                                 (id . ((type . "string")
                                        (description . "Org ID of the entry")))))
                  (required . ["id"]))
  :function #'rail-tools--show-handler
  :annotations '((readOnlyHint . t)
                 (destructiveHint . :false)
                 (idempotentHint . t)
                 (openWorldHint . :false))))

;;; retag

(defun rail-tools--retag-handler (args)
  "Replace the tags on an entry with a validated set.
ARGS keys: `root', `id', `tags' (array).  Validate TAGS against the
file vocabulary, then set them, keeping the file's default tag
alignment."
  (rail-tools--json
    (let ((file (rail-tools--file args))
          (id   (or (alist-get 'id args) (error "Missing `id'")))
          (raw-tags (append (alist-get 'tags args) nil)))
      (with-current-buffer (rail-tools--buffer file)
        (let ((tags (rail-tools--check-tags raw-tags)))
          (rail-tools--goto-id id)
          (org-set-tags tags)
          (when (buffer-modified-p) (save-buffer))
          `((id . ,id)
            (tags . ,(vconcat (org-get-tags nil t)))))))))

(mcp-server-register-tool
 (make-mcp-server-tool
  :name "rail-retag"
  :title "RAIL Retag"
  :description "Replace the tags on a RAIL entry with a validated set from the file vocabulary.  Use this tool to re-tag an entry as its shape changes.  The tool keeps the file's default tag alignment."
  :input-schema '((type . "object")
                  (properties . ((root . ((type . "string")))
                                 (id . ((type . "string")
                                        (description . "Org ID of the entry")))
                                 (tags . ((type . "array")
                                          (items . ((type . "string")))
                                          (description . "Tags from the file vocabulary")))))
                  (required . ["id" "tags"]))
  :function #'rail-tools--retag-handler
  :annotations '((readOnlyHint . :false)
                 (destructiveHint . :false)
                 (idempotentHint . :false)
                 (openWorldHint . :false))))

;;; cancel and block

(defun rail-tools--transition-with-reason (id keyword purpose reason)
  "Transition entry ID to KEYWORD and record REASON as a closing note.
Signal an error when REASON is missing or blank.  Set the TODO keyword
first, so the state timestamp lands, then write REASON as a PURPOSE
closing note in the `:LOGBOOK:' drawer.  PURPOSE is `blocked' or
`cancelled'.  The closing note replaces the old `- PURPOSE ::' body
line, so the decision is never silent."
  (when (or (null reason) (string-empty-p (string-trim reason)))
    (error "A reason is required"))
  (rail-tools--goto-id id)
  (org-todo keyword)
  (rail-tools--goto-id id)
  (rail-tools--append-closing-note purpose (string-trim reason))
  (when (buffer-modified-p) (save-buffer)))

(defun rail-tools--cancel-handler (args)
  "Set an entry to CANCELLED with a required reason.
ARGS keys: `root', `id', `reason'.  Record REASON as a `CANCELLED NOTE'
closing note in the `:LOGBOOK:' drawer, so the decision is never
silent."
  (rail-tools--json
    (let ((file   (rail-tools--file args))
          (id     (or (alist-get 'id args) (error "Missing `id'")))
          (reason (alist-get 'reason args)))
      (with-current-buffer (rail-tools--buffer file)
        (rail-tools--transition-with-reason id "CANCELLED" 'cancelled reason)
        (rail-tools--goto-id id)
        `((id . ,id)
          (state . ,(org-get-todo-state)))))))

(mcp-server-register-tool
 (make-mcp-server-tool
  :name "rail-cancel"
  :title "RAIL Cancel"
  :description "Set a RAIL entry to CANCELLED and record a required reason as a CANCELLED NOTE closing note in the :LOGBOOK: drawer, so the decision is never silent."
  :input-schema '((type . "object")
                  (properties . ((root . ((type . "string")))
                                 (id . ((type . "string")
                                        (description . "Org ID of the entry")))
                                 (reason . ((type . "string")
                                            (description . "Reason for cancelling the entry")))))
                  (required . ["id" "reason"]))
  :function #'rail-tools--cancel-handler
  :annotations '((readOnlyHint . :false)
                 (destructiveHint . :false)
                 (idempotentHint . :false)
                 (openWorldHint . :false))))

(defun rail-tools--block-handler (args)
  "Set an entry to BLOCKED with a required reason.
ARGS keys: `root', `id', `reason'.  Record REASON as a `BLOCKED NOTE'
closing note in the `:LOGBOOK:' drawer, so the blocker is never
silent."
  (rail-tools--json
    (let ((file   (rail-tools--file args))
          (id     (or (alist-get 'id args) (error "Missing `id'")))
          (reason (alist-get 'reason args)))
      (with-current-buffer (rail-tools--buffer file)
        (rail-tools--transition-with-reason id "BLOCKED" 'blocked reason)
        (rail-tools--goto-id id)
        `((id . ,id)
          (state . ,(org-get-todo-state)))))))

(mcp-server-register-tool
 (make-mcp-server-tool
  :name "rail-block"
  :title "RAIL Block"
  :description "Set a RAIL entry to BLOCKED and record a required reason as a BLOCKED NOTE closing note in the :LOGBOOK: drawer, so the blocker is never silent."
  :input-schema '((type . "object")
                  (properties . ((root . ((type . "string")))
                                 (id . ((type . "string")
                                        (description . "Org ID of the entry")))
                                 (reason . ((type . "string")
                                            (description . "Reason for blocking the entry")))))
                  (required . ["id" "reason"]))
  :function #'rail-tools--block-handler
  :annotations '((readOnlyHint . :false)
                 (destructiveHint . :false)
                 (idempotentHint . :false)
                 (openWorldHint . :false))))

;;; complete

(defun rail-tools--complete-handler (args)
  "Set an entry to DONE with its closing note and confirm CLOSED.
ARGS keys: `root', `id', `commit', `tests', `model' (optional),
`notes' (optional).  Transition to DONE, then write the closing note
into the `:LOGBOOK:' drawer next to the CLOSED timestamp.  Requires
`org-log-done' to be `time' so the normal Org transition inserts
CLOSED; this handler never writes CLOSED."
  (rail-tools--json
    (let ((file   (rail-tools--file args))
          (id     (or (alist-get 'id args) (error "Missing `id'")))
          (commit (or (alist-get 'commit args) (error "Missing `commit'")))
          (tests  (or (alist-get 'tests args) (error "Missing `tests'")))
          (model  (alist-get 'model args))
          (notes  (alist-get 'notes args)))
      (with-current-buffer (rail-tools--buffer file)
        (hack-local-variables)
        (unless (eq org-log-done 'time)
          (error "org-log-done is not set to time"))
        (rail-tools--goto-id id)
        (org-todo "DONE")
        (rail-tools--goto-id id)
        (rail-tools--append-closing-note
         'done (rail-tools--closing-note-text commit tests model notes))
        (when (buffer-modified-p) (save-buffer))
        (let ((closed (org-entry-get nil "CLOSED")))
          (unless closed
            (error "Org did not record a CLOSED timestamp"))
          `((id . ,id)
            (state . ,(org-get-todo-state))
            (result . ,(rail-tools--result-text))
            (closed . ,closed)))))))

(mcp-server-register-tool
 (make-mcp-server-tool
  :name "rail-complete"
  :title "RAIL Complete"
  :description "Set a RAIL entry to DONE.  The tool writes the closing note as a CLOSING NOTE item in the :LOGBOOK: drawer.  The note holds the commit hash, a short test recap, and optionally the agent that did the work and a free-text note.  The tool then confirms that Org inserted a CLOSED timestamp.  The file must set org-log-done to time.  The tool never writes the timestamp itself.  The entry stays in place, and there is no refile step."
  :input-schema '((type . "object")
                  (properties . ((root . ((type . "string")))
                                 (id . ((type . "string")))
                                 (commit . ((type . "string")
                                            (description . "Commit hash for the completed work")))
                                 (tests . ((type . "string")
                                           (description . "Short test recap, for example \"215 pass\"")))
                                 (model . ((type . "string")
                                           (description . "Optional model or agent that did the work, for example the agent name")))
                                 (notes . ((type . "string")
                                           (description . "Optional free-text tail appended after a semicolon, for example a root cause")))))
                  (required . ["id" "commit" "tests"]))
  :function #'rail-tools--complete-handler
  :annotations '((readOnlyHint . :false)
                 (destructiveHint . :false)
                 (idempotentHint . t)
                 (openWorldHint . :false))))

;;; verify (read-only)

(defun rail-tools--verify-handler (args)
  "Return the current state of the entry with `id'.
ARGS keys: `root', `id'.  Read-only."
  (rail-tools--json
    (let ((file (rail-tools--file args))
          (id   (or (alist-get 'id args) (error "Missing `id'"))))
      (with-current-buffer (rail-tools--buffer file)
        (org-with-wide-buffer
         (rail-tools--goto-id id)
         `((id . ,id)
           (heading . ,(org-get-heading t t t t))
           (state . ,(org-get-todo-state))
           (closed . ,(org-entry-get nil "CLOSED"))
           (tags . ,(vconcat (org-get-tags nil t)))))))))

(mcp-server-register-tool
 (make-mcp-server-tool
  :name "rail-verify"
  :title "RAIL Verify"
  :description "Return the heading, TODO state, CLOSED timestamp, and tags of a RAIL entry.  Read-only."
  :input-schema '((type . "object")
                  (properties . ((root . ((type . "string")))
                                 (id . ((type . "string")))))
                  (required . ["id"]))
  :function #'rail-tools--verify-handler
  :annotations '((readOnlyHint . t)
                 (destructiveHint . :false)
                 (idempotentHint . t)
                 (openWorldHint . :false))))

(provide 'rail-tools)

;;; rail-tools.el ends here