;;; rail-tests.el --- End-to-end tests for the RAIL tools -*- lexical-binding: t; -*-

;;; Commentary:

;; These tests exercise the RAIL handler functions directly.  The MCP
;; framework calls each handler with one alist of arguments, so a direct call
;; follows the same path as a tool call.  Each test runs against a temporary
;; stream file, so no test touches the project stream file.
;;
;; Run the tests with the runner script in this directory:
;;
;;   ./run-tests.sh

;;; Code:

(require 'ert)
(require 'json)

;;; Fixtures

(defvar rail-tests--preamble
  (concat "#+TITLE: Test stream\n"
          "#+TODO: TODO IN-PROGRESS TESTING TESTED BLOCKED | CANCELLED DONE\n"
          "#+TAGS: [ Kind : feat fix refactor chore docs ]\n"
          "#+TAGS: [ Scope : core app web ui ]\n"
          "#+TAGS: [ Impact : minor major ]\n"
          "\n"
          "# Local Variables:\n"
          "# org-log-done: time\n"
          "# End:\n")
  "Preamble of the temporary stream file.
The `#+TODO:' line gives the keyword sequence.  The `#+TAGS:' lines give
the tag vocabulary, grouped into axes.  The local variable
`org-log-done' makes Org write a CLOSED timestamp.")

(defun rail-tests--decode (json-string)
  "Return JSON-STRING decoded into Lisp with alists for objects.
Decode JSON null to nil and JSON false to `:json-false', which are the
same sentinels that the handlers encode from.  A round trip therefore
gives back the value that the handler started with."
  (json-parse-string json-string
                     :object-type 'alist
                     :null-object nil
                     :false-object :json-false))

(defun rail-tests--call (handler args)
  "Call HANDLER with ARGS and return the decoded result.
Signal an error when the handler reports one, so a failure is visible."
  (let ((result (rail-tests--decode (funcall handler args))))
    (when (alist-get 'error result)
      (error "Handler failed: %s" (alist-get 'error result)))
    result))

(defmacro rail-tests--with-stream (root &rest body)
  "Create a temporary project directory, bind ROOT to it, then run BODY.
Delete the directory and its buffers after BODY."
  (declare (indent 1))
  `(let* ((,root (file-name-as-directory (make-temp-file "rail-test" t)))
          (file (expand-file-name rail-stream-file-name ,root))
          (enable-local-variables :all)
          (org-id-track-globally nil)
          (create-lockfiles nil))
     (unwind-protect
         (progn
           (with-temp-file file (insert rail-tests--preamble))
           ,@body)
       (dolist (buf (buffer-list))
         (when (and (buffer-file-name buf)
                    (string-prefix-p ,root (buffer-file-name buf)))
           (with-current-buffer buf (set-buffer-modified-p nil))
           (kill-buffer buf)))
       (delete-directory ,root t))))

(defun rail-tests--capture (root title tags &optional body)
  "Capture a request in ROOT with TITLE, TAGS, and optional BODY.
Return the new entry's Org ID."
  (alist-get 'id (rail-tests--call
                  #'rail-tools--capture-handler
                  (list (cons 'root root)
                        (cons 'title title)
                        (cons 'tags tags)
                        (cons 'body (or body "Request body."))))))

(defun rail-tests--file-text (root)
  "Return the text of the stream file in ROOT."
  (with-temp-buffer
    (insert-file-contents (expand-file-name rail-stream-file-name root))
    (buffer-string)))

;;; Root discovery

(ert-deftest rail-test-locate-root-finds-the-stream-file ()
  "`rail-locate-root' finds the root from a nested directory."
  (rail-tests--with-stream root
    (let ((nested (expand-file-name "a/b/c/" root)))
      (make-directory nested t)
      (should (equal (rail-locate-root nested) root)))))

(ert-deftest rail-test-locate-root-returns-nil-without-a-stream-file ()
  "`rail-locate-root' returns nil when no ancestor holds the file."
  (let ((empty (file-name-as-directory (make-temp-file "rail-empty" t))))
    (unwind-protect
        (should (null (rail-locate-root empty)))
      (delete-directory empty t))))

(ert-deftest rail-test-root-argument-overrides-the-default ()
  "An explicit `root' argument selects the file, not `rail-project-root'."
  (rail-tests--with-stream root
    (should (equal (rail-tools--file (list (cons 'root root)))
                   (expand-file-name rail-stream-file-name root)))))

(ert-deftest rail-test-absent-root-uses-the-default ()
  "An absent `root' argument falls back to `rail-project-root'."
  (rail-tests--with-stream root
    (let ((rail-project-root root))
      (should (equal (rail-tools--file nil)
                     (expand-file-name rail-stream-file-name root))))))

(ert-deftest rail-test-a-missing-directory-signals-an-error ()
  "A `root' that is not a directory signals an error."
  (should-error (rail-tools--file
                 (list (cons 'root "/rail/no/such/directory")))))

;;; Capture

(ert-deftest rail-test-capture-creates-an-addressable-todo ()
  "Capture writes a TODO entry with an ID, a SCHEDULED time, and tags."
  (rail-tests--with-stream root
    (let* ((id (rail-tests--capture root "Add a widget" ["feat" "web"]))
           (entry (rail-tests--call #'rail-tools--show-handler
                                      (list (cons 'root root) (cons 'id id)))))
      (should (stringp id))
      (should (equal (alist-get 'state entry) "TODO"))
      (should (equal (alist-get 'heading entry) "Add a widget"))
      (should (equal (append (alist-get 'tags entry) nil) '("feat" "web")))
      (should (stringp (alist-get 'scheduled entry)))
      (should (null (alist-get 'closed entry))))))

(ert-deftest rail-test-capture-puts-the-newest-request-first ()
  "Capture inserts each new request above the previous request."
  (rail-tests--with-stream root
    (rail-tests--capture root "First request" ["feat" "core"])
    (rail-tests--capture root "Second request" ["fix" "app"])
    (let ((rows (rail-tests--decode
                 (rail-tools--list-handler (list (cons 'root root))))))
      (should (equal (length rows) 2))
      (should (equal (alist-get 'title (aref rows 0)) "Second request"))
      (should (equal (alist-get 'title (aref rows 1)) "First request")))))

(ert-deftest rail-test-capture-rejects-a-tag-outside-the-vocabulary ()
  "Capture rejects any tag that the closed vocabulary does not hold."
  (rail-tests--with-stream root
    (let ((result (rail-tests--decode
                   (rail-tools--capture-handler
                    (list (cons 'root root)
                          (cons 'title "Bad tags")
                          (cons 'tags ["feat" "trivial"]))))))
      (should (string-match-p "Unknown tag" (alist-get 'error result))))))

;;; Status

(ert-deftest rail-test-set-status-moves-through-the-open-keywords ()
  "Set-status accepts each open keyword from the file's own sequence."
  (rail-tests--with-stream root
    (let ((id (rail-tests--capture root "Track status" ["feat" "core"])))
      (dolist (state '("IN-PROGRESS" "TESTING" "TESTED"))
        (let ((result (rail-tests--call
                       #'rail-tools--set-status-handler
                       (list (cons 'root root) (cons 'id id)
                             (cons 'state state)))))
          (should (equal (alist-get 'state result) state))))
      (should (equal (alist-get 'state (rail-tests--call
                                       #'rail-tools--verify-handler
                                       (list (cons 'root root) (cons 'id id))))
                     "TESTED")))))

(ert-deftest rail-test-set-status-refuses-done ()
  "Set-status refuses DONE, because completion needs result evidence."
  (rail-tests--with-stream root
    (let* ((id (rail-tests--capture root "Refuse done" ["feat" "core"]))
           (result (rail-tests--decode
                    (rail-tools--set-status-handler
                     (list (cons 'root root) (cons 'id id)
                           (cons 'state "DONE"))))))
      (should (string-match-p "rail-complete" (alist-get 'error result))))))

(ert-deftest rail-test-block-and-cancel-record-a-reason ()
  "Block and cancel write the reason, so the decision is never silent."
  (rail-tests--with-stream root
    (let ((blocked (rail-tests--capture root "Blocked work" ["feat" "app"]))
          (dropped (rail-tests--capture root "Dropped work" ["feat" "ui"])))
      (rail-tests--call #'rail-tools--block-handler
                          (list (cons 'root root) (cons 'id blocked)
                                (cons 'reason "The route does not exist")))
      (rail-tests--call #'rail-tools--cancel-handler
                          (list (cons 'root root) (cons 'id dropped)
                                (cons 'reason "The user withdrew the request")))
      (let ((text (rail-tests--file-text root)))
        (should (string-match-p
                 "- BLOCKED NOTE \\[.*\\] :: The route does not exist" text))
        (should (string-match-p
                 "- CANCELLED NOTE \\[.*\\] :: The user withdrew" text))
        ;; The note lives in the LOGBOOK drawer, not as a body line.
        (should-not (string-match-p "- blocked ::" text))
        (should-not (string-match-p "- cancelled ::" text)))
      (should (equal "BLOCKED"
                     (alist-get 'state (rail-tests--call
                                        #'rail-tools--verify-handler
                                        (list (cons 'root root)
                                              (cons 'id blocked))))))
      (should (equal "CANCELLED"
                     (alist-get 'state (rail-tests--call
                                        #'rail-tools--verify-handler
                                        (list (cons 'root root)
                                              (cons 'id dropped)))))))))

(ert-deftest rail-test-block-requires-a-reason ()
  "Block refuses a blank reason."
  (rail-tests--with-stream root
    (let* ((id (rail-tests--capture root "Needs a reason" ["feat" "app"]))
           (result (rail-tests--decode
                    (rail-tools--block-handler
                     (list (cons 'root root) (cons 'id id)
                           (cons 'reason "  "))))))
      (should (string-match-p "reason" (alist-get 'error result))))))

;;; Checklist, logbook, and tags

(ert-deftest rail-test-checklist-adds-and-toggles-items ()
  "The checklist adds an item, then toggles it, and reports booleans."
  (rail-tests--with-stream root
    (let ((id (rail-tests--capture root "Split the task" ["feat" "core"])))
      (let ((added (rail-tests--call
                    #'rail-tools--check-handler
                    (list (cons 'root root) (cons 'id id)
                          (cons 'action "add") (cons 'item "step one")))))
        (should (equal (alist-get 'done (aref (alist-get 'items added) 0))
                       :json-false)))
      (let ((toggled (rail-tests--call
                      #'rail-tools--check-handler
                      (list (cons 'root root) (cons 'id id)
                            (cons 'action "toggle") (cons 'item "step one")))))
        (should (eq (alist-get 'done (aref (alist-get 'items toggled) 0)) t)))
      (should (string-match-p "Checklist \\[1/1\\]" (rail-tests--file-text root))))))

(ert-deftest rail-test-log-appends-and-keeps-earlier-notes ()
  "The logbook keeps every note, newest first."
  (rail-tests--with-stream root
    (let ((id (rail-tests--capture root "Log progress" ["feat" "core"])))
      (rail-tests--call #'rail-tools--log-handler
                          (list (cons 'root root) (cons 'id id)
                                (cons 'note "First note")))
      (rail-tests--call #'rail-tools--log-handler
                          (list (cons 'root root) (cons 'id id)
                                (cons 'note "Second note")))
      (let* ((entry (rail-tests--call #'rail-tools--show-handler
                                        (list (cons 'root root) (cons 'id id))))
             (notes (append (alist-get 'logbook entry) nil)))
        (should (equal (length notes) 2))
        (should (string-match-p "Second note" (nth 0 notes)))
        (should (string-match-p "First note" (nth 1 notes)))))))

(ert-deftest rail-test-retag-validates-against-the-vocabulary ()
  "Retag replaces the tags, and refuses a tag outside the vocabulary."
  (rail-tests--with-stream root
    (let ((id (rail-tests--capture root "Retag me" ["feat" "core"])))
      (let ((result (rail-tests--call
                     #'rail-tools--retag-handler
                     (list (cons 'root root) (cons 'id id)
                           (cons 'tags ["fix" "web" "minor"])))))
        (should (equal (append (alist-get 'tags result) nil)
                       '("fix" "web" "minor"))))
      (let ((result (rail-tests--decode
                     (rail-tools--retag-handler
                      (list (cons 'root root) (cons 'id id)
                            (cons 'tags ["nonsense"]))))))
        (should (string-match-p "Unknown tag" (alist-get 'error result)))))))

;;; Result and completion

(ert-deftest rail-test-set-result-writes-model-and-notes ()
  "The result line holds the model, the commit, the tests, and the notes."
  (rail-tests--with-stream root
    (let* ((id (rail-tests--capture root "Record a result" ["fix" "core"]))
           (result (rail-tests--call
                    #'rail-tools--set-result-handler
                    (list (cons 'root root) (cons 'id id)
                          (cons 'commit "abc1234") (cons 'tests "246 pass")
                          (cons 'model "test-agent")
                          (cons 'notes "the sentinel was wrong")))))
      (should (equal (alist-get 'result result)
                     "model=test-agent commit=abc1234 tests=246 pass; the sentinel was wrong")))))

(ert-deftest rail-test-set-result-omits-absent-optional-fields ()
  "The result line holds only the commit and the tests when nothing else is given."
  (rail-tests--with-stream root
    (let* ((id (rail-tests--capture root "Plain result" ["fix" "core"]))
           (result (rail-tests--call
                    #'rail-tools--set-result-handler
                    (list (cons 'root root) (cons 'id id)
                          (cons 'commit "abc1234") (cons 'tests "246 pass")))))
      (should (equal (alist-get 'result result)
                     "commit=abc1234 tests=246 pass")))))

(ert-deftest rail-test-set-result-replaces-an-earlier-line ()
  "A second result call replaces the earlier result line."
  (rail-tests--with-stream root
    (let ((id (rail-tests--capture root "Replace result" ["fix" "core"])))
      (dolist (commit '("aaa1111" "bbb2222"))
        (rail-tests--call #'rail-tools--set-result-handler
                            (list (cons 'root root) (cons 'id id)
                                  (cons 'commit commit) (cons 'tests "1 pass"))))
      (let ((text (rail-tests--file-text root)))
        (should-not (string-match-p "aaa1111" text))
        (should (string-match-p "bbb2222" text))))))

(ert-deftest rail-test-complete-sets-done-with-result-and-closed ()
  "Completion writes the result, sets DONE, and confirms the CLOSED time."
  (rail-tests--with-stream root
    (let* ((id (rail-tests--capture root "Finish the work" ["feat" "core"]))
           (result (rail-tests--call
                    #'rail-tools--complete-handler
                    (list (cons 'root root) (cons 'id id)
                          (cons 'commit "def5678") (cons 'tests "247 pass")
                          (cons 'model "test-agent")))))
      (should (equal (alist-get 'state result) "DONE"))
      (should (string-match-p "commit=def5678" (alist-get 'result result)))
      (should (string-match-p "\\[.*\\]" (alist-get 'closed result)))
      ;; The closing note is a CLOSING NOTE item in the LOGBOOK drawer,
      ;; not a `- result ::' body line.
      (let ((text (rail-tests--file-text root)))
        (should (string-match-p ":LOGBOOK:" text))
        (should (string-match-p
                 "- CLOSING NOTE \\[.*\\] :: model=test-agent commit=def5678"
                 text))
        (should-not (string-match-p "- result ::" text)))
      (let ((entry (rail-tests--call #'rail-tools--verify-handler
                                       (list (cons 'root root) (cons 'id id)))))
        (should (equal (alist-get 'state entry) "DONE"))
        (should (stringp (alist-get 'closed entry)))))))

(ert-deftest rail-test-complete-refuses-a-file-without-closed-logging ()
  "Completion refuses to run when the file does not log a CLOSED time.
Org must write the CLOSED timestamp, so the tool never writes it."
  (let* ((root (file-name-as-directory (make-temp-file "rail-nolog" t)))
         (file (expand-file-name rail-stream-file-name root))
         (enable-local-variables :all)
         (org-id-track-globally nil)
         (create-lockfiles nil)
         (org-log-done nil))
    (unwind-protect
        (progn
          ;; This preamble holds no `org-log-done' local variable.
          (with-temp-file file
            (insert "#+TITLE: No logging\n"
                    "#+TODO: TODO IN-PROGRESS | CANCELLED DONE\n"))
          (let ((id (rail-tests--capture root "No logging" ["feat" "core"])))
            ;; Close the buffer, so the next open reads the local variables
            ;; of the file as it now stands.
            (dolist (buf (buffer-list))
              (when (equal (buffer-file-name buf) file)
                (with-current-buffer buf (set-buffer-modified-p nil))
                (kill-buffer buf)))
            (let ((result (rail-tests--decode
                           (rail-tools--complete-handler
                            (list (cons 'root root) (cons 'id id)
                                  (cons 'commit "def5678")
                                  (cons 'tests "1 pass"))))))
              (should (stringp (alist-get 'error result)))
              (should (string-match-p "org-log-done"
                                      (alist-get 'error result))))))
      (dolist (buf (buffer-list))
        (when (and (buffer-file-name buf)
                   (string-prefix-p root (buffer-file-name buf)))
          (with-current-buffer buf (set-buffer-modified-p nil))
          (kill-buffer buf)))
      (delete-directory root t))))

;;; Reading

(ert-deftest rail-test-list-encodes-an-absent-value-as-json-null ()
  "A heading without an ID reports JSON null, not the text \"null\"."
  (rail-tests--with-stream root
    (let ((file (expand-file-name rail-stream-file-name root)))
      (with-current-buffer (find-file-noselect file)
        (goto-char (point-min))
        (insert "* TODO Entry without an identifier :feat:core:\n")
        (save-buffer))
      (let* ((json (rail-tools--list-handler (list (cons 'root root))))
             (rows (rail-tests--decode json)))
        (should (null (alist-get 'id (aref rows 0))))
        (should-not (string-match-p "\"null\"" json))))))

(ert-deftest rail-test-list-filters-by-state-and-tag ()
  "The list filters narrow the result by TODO keyword and by tag."
  (rail-tests--with-stream root
    (let ((first (rail-tests--capture root "Filter one" ["feat" "core"])))
      (rail-tests--capture root "Filter two" ["fix" "web"])
      (rail-tests--call #'rail-tools--set-status-handler
                          (list (cons 'root root) (cons 'id first)
                                (cons 'state "IN-PROGRESS")))
      (let ((by-state (rail-tests--decode
                       (rail-tools--list-handler
                        (list (cons 'root root) (cons 'state "IN-PROGRESS")))))
            (by-tag (rail-tests--decode
                     (rail-tools--list-handler
                      (list (cons 'root root) (cons 'tag "web"))))))
        (should (equal (length by-state) 1))
        (should (equal (alist-get 'title (aref by-state 0)) "Filter one"))
        (should (equal (length by-tag) 1))
        (should (equal (alist-get 'title (aref by-tag 0)) "Filter two"))))))

(ert-deftest rail-test-inspect-reports-the-sequence-and-the-axes ()
  "Inspect reports the file's keyword sequence and the file's tag axes."
  (rail-tests--with-stream root
    (let* ((result (rail-tests--call #'rail-tools--inspect-handler
                                       (list (cons 'root root))))
           (keywords (append (alist-get 'todo_keywords result) nil))
           (axes (alist-get 'tags result)))
      (should (member "IN-PROGRESS" keywords))
      (should (member "DONE" keywords))
      ;; The axes come from the file's own #+TAGS: lines, not from the code.
      (should (equal (mapcar #'car axes) '(kind scope impact)))
      (should (equal (append (alist-get 'impact axes) nil) '("minor" "major")))
      (should (equal (append (alist-get 'scope axes) nil) '("core" "app" "web" "ui"))))))

(ert-deftest rail-test-a-file-without-tags-accepts-any-tag ()
  "A file that declares no #+TAGS: vocabulary accepts any tag.
The tool carries no vocabulary of its own, so an undeclared file places
no restriction on the tags."
  (let* ((root (file-name-as-directory (make-temp-file "rail-notags" t)))
         (file (expand-file-name rail-stream-file-name root))
         (org-id-track-globally nil)
         (create-lockfiles nil))
    (unwind-protect
        (progn
          (with-temp-file file
            (insert "#+TITLE: No vocabulary\n"
                    "#+TODO: TODO | DONE\n"))
          (let* ((cap (rail-tests--call
                       #'rail-tools--capture-handler
                       (list (cons 'root root)
                             (cons 'title "Any tag is fine")
                             (cons 'tags ["anything" "at" "all"]))))
                 (id (alist-get 'id cap)))
            (should (stringp id))
            (should (equal (append (alist-get 'tags cap) nil)
                           '("anything" "at" "all")))))
      (dolist (buf (buffer-list))
        (when (and (buffer-file-name buf)
                   (string-prefix-p root (buffer-file-name buf)))
          (with-current-buffer buf (set-buffer-modified-p nil))
          (kill-buffer buf)))
      (delete-directory root t))))

;;; The full path

(ert-deftest rail-test-the-full-request-path-runs-end-to-end ()
  "One request moves from capture to DONE through every step."
  (rail-tests--with-stream root
    (let ((id (rail-tests--capture root "Ship the feature" ["feat" "web"]
                                     "Add a widget to the page.")))
      (rail-tests--call #'rail-tools--check-handler
                          (list (cons 'root root) (cons 'id id)
                                (cons 'action "add") (cons 'item "write the code")))
      (rail-tests--call #'rail-tools--set-status-handler
                          (list (cons 'root root) (cons 'id id)
                                (cons 'state "IN-PROGRESS")))
      (rail-tests--call #'rail-tools--log-handler
                          (list (cons 'root root) (cons 'id id)
                                (cons 'note "Started the work")))
      (rail-tests--call #'rail-tools--check-handler
                          (list (cons 'root root) (cons 'id id)
                                (cons 'action "toggle")
                                (cons 'item "write the code")))
      (rail-tests--call #'rail-tools--set-status-handler
                          (list (cons 'root root) (cons 'id id)
                                (cons 'state "TESTED")))
      (rail-tests--call #'rail-tools--complete-handler
                          (list (cons 'root root) (cons 'id id)
                                (cons 'commit "0badc0de") (cons 'tests "3 pass")
                                (cons 'model "test-agent")))
      (let ((entry (rail-tests--call #'rail-tools--show-handler
                                       (list (cons 'root root) (cons 'id id)))))
        (should (equal (alist-get 'state entry) "DONE"))
        (should (stringp (alist-get 'closed entry)))
        (should (string-match-p "commit=0badc0de" (alist-get 'result entry)))
        ;; The logbook now holds the progress note plus the closing note.
        (should (equal (length (alist-get 'logbook entry)) 2))
        (should (seq-some (lambda (n) (string-match-p "CLOSING NOTE" n))
                          (alist-get 'logbook entry)))
        (should (eq (alist-get 'done (aref (alist-get 'checklist entry) 0)) t))
        (should (string-match-p "Add a widget" (alist-get 'body entry)))))))

(provide 'rail-tests)

;;; rail-tests.el ends here