;;; test-flan-repl.el --- The prompt's history, at a stub prompt  -*- lexical-binding: t; -*-

;; Loaded by test-flan-cider.el, which runs under `dune test', for the reason
;; test-flan-mode.el gives: `emacs/*.el' is already a dependency of that
;; stanza, so a file here needs no build change to be run.
;;
;; Nothing here needs a daemon, and that is not a shortcut.  History is a
;; function from *a ring and where point is* to *what the buffer says*, and the
;; failures worth catching are all on that side: an up-arrow that recalls where
;; someone meant to scroll, a second press that does not move because comint
;; cannot see its own name in `last-command', a form typed over several lines
;; that comes back out of the file in pieces.  Evaluation is the other half and
;; test_emacs drives it against a real program.
;;
;; The one thing that must be borrowed from the real thing is the process: the
;; input line is wherever the process mark is, so a prompt with no process
;; behind it has no input line to be on.  It is the same `cat' stub
;; `flan-repl' starts, for the same reason its comment gives.

;;; Code:

(require 'flan-repl)
(require 'ring)

(declare-function test-flan--check "test-flan-cider" (name ok))
(declare-function test-flan--caught "test-flan-cider" (thunk))

(defvar test-flan-repl--history
  (make-temp-name (expand-file-name "flan-repl-history-"
                                    temporary-file-directory))
  "Where these checks keep history.
Never the user's own file: `kill-emacs-hook' saves every REPL buffer, and a
batch run exits through `kill-emacs' like any other.")

(defun test-flan-repl--buffer (&optional inputs)
  "A live `flan-repl-mode' buffer at a fresh prompt, with INPUTS in its ring.
INPUTS are given oldest first, the order they would have been typed in."
  (let ((buf (get-buffer-create "*test-flan-repl*")))
    (with-current-buffer buf
      (let ((flan-repl-history-file test-flan-repl--history))
        (flan-repl-mode))
      (let ((proc (start-process "test-flan-repl" buf "cat")))
        (set-process-query-on-exit-flag proc nil)
        (comint-output-filter proc flan-repl-prompt))
      (dolist (input inputs) (ring-insert comint-input-ring input))
      (setq comint-input-ring-index nil)
      ;; The keypresses below are checked for what they do, so they are run
      ;; through the map the same way a keypress reaches them.
      (setq last-command nil))
    buf))

(defun test-flan-repl--press (key)
  "Run KEY's binding in the current buffer the way a keypress would.
Through `call-interactively' and with `last-command' carried across, because
both are what the commands under test read: the binding is half the claim, and
comint's search reads the command that ran before it."
  (let ((cmd (key-binding (kbd key)))
        ;; Quiet: comint says which history item it landed on, and in batch
        ;; that lands in the middle of the line a result is printed on.
        (inhibit-message t))
    (setq this-command cmd)
    (call-interactively cmd)
    (setq last-command this-command)))

(defun test-flan-repl--input ()
  "The text currently typed at the prompt."
  (buffer-substring-no-properties
   (process-mark (get-buffer-process (current-buffer)))
   (point-max)))

(defun test-flan-repl--done (buf)
  "Finish with BUF, writing no history on the way out.
The hook has to come off the buffer rather than be bound away around the kill:
it is buffer-local, and a `let' outside the buffer does not reach it.  Saving
here would make every check below read a file the one above it happened to
leave, which is a test of the order they are written in."
  (with-current-buffer buf
    (remove-hook 'kill-buffer-hook #'flan-repl--save-history t)
    (let ((proc (get-buffer-process buf)))
      (when proc (delete-process proc))))
  (kill-buffer buf))

;;; Up-arrow at the prompt

(let ((buf (test-flan-repl--buffer '("(+ 1 2)" "(foo 1)"))))
  (with-current-buffer buf
    (test-flan-repl--press "<up>")
    (test-flan--check "up at the prompt recalls the last input"
                      (equal (test-flan-repl--input) "(foo 1)"))
    (test-flan-repl--press "<up>")
    ;; The press that discriminates: comint decides whether a press continues
    ;; the search by looking for its own command name in `last-command', and a
    ;; wrapper that does not hand it over searches again from the entry it just
    ;; inserted, so the first press looks perfect and the second does nothing.
    (test-flan--check "and a second press reaches the one before it"
                      (equal (test-flan-repl--input) "(+ 1 2)"))
    (test-flan-repl--press "<down>")
    (test-flan--check "down comes back up the ring"
                      (equal (test-flan-repl--input) "(foo 1)")))
  (test-flan-repl--done buf))

(let ((buf (test-flan-repl--buffer '("(+ 1 2)" "(foo 1)" "(bar 2)"))))
  (with-current-buffer buf
    (insert "(f")
    (test-flan-repl--press "<up>")
    (test-flan--check "what is already typed filters the search, as a shell does"
                      (equal (test-flan-repl--input) "(foo 1)")))
  (test-flan-repl--done buf))

;;; Up-arrow above the prompt

(let ((buf (test-flan-repl--buffer '("(+ 1 2)"))))
  (with-current-buffer buf
    ;; The transcript above the prompt is read by scrolling back through it,
    ;; which a blunt history binding would make impossible.
    (comint-output-filter (get-buffer-process buf)
                          (concat "3\n" flan-repl-prompt))
    (goto-char (point-min))
    (let ((line-move-visual nil)
          (where (point)))
      (test-flan-repl--press "<down>")
      (test-flan--check "down above the input moves a line, and recalls nothing"
                        (and (> (point) where)
                             (string-empty-p (test-flan-repl--input))))
      (test-flan-repl--press "<up>")
      (test-flan--check "and up moves back"
                        (and (= (point) where)
                             (string-empty-p (test-flan-repl--input))))))
  (test-flan-repl--done buf))

;;; A form typed over several lines

(let ((buf (test-flan-repl--buffer)))
  (with-current-buffer buf
    (let ((line-move-visual nil))
      (insert "(defn f [x]")
      (test-flan-repl--press "RET")
      (test-flan--check "RET on a half-typed form opens a line instead of sending"
                        (equal (test-flan-repl--input) "(defn f [x]\n"))
      ;; The line RET just opened is empty and is the last one, so `<down>'
      ;; does go to history — with a prefix that spans the newline and matches
      ;; nothing, which comint refuses rather than answering.  What matters is
      ;; that the half-typed form is still there afterwards.
      (test-flan--check "down on the opened line leaves the half-typed form alone"
                        (and (test-flan--caught
                              (lambda () (test-flan-repl--press "<down>")))
                             (equal (test-flan-repl--input) "(defn f [x]\n")))
      (insert "  (+ x 1))")
      (test-flan-repl--press "<up>")
      ;; Inside the form the key is line motion, not history: the lines of one
      ;; input are as much a thing to move around in as the transcript is.
      (test-flan--check "up inside the form moves between its lines"
                        (and (equal (test-flan-repl--input) "(defn f [x]\n  (+ x 1))")
                             (flan-repl--on-first-input-line-p)))))
  (test-flan-repl--done buf))

(let* ((buf (test-flan-repl--buffer '("(defn f [x]\n  (+ x 1))")))
       (sent nil))
  (with-current-buffer buf
    (setq-local comint-input-sender (lambda (_proc text) (setq sent text)))
    (test-flan-repl--press "<up>")
    ;; History leaves point where the typing stopped, which for an empty prompt
    ;; is the start of what was just recalled.  `comint-send-input' sends only
    ;; as far as point, so a recalled form is exactly the case where sending
    ;; the line under point would send nothing at all.
    (test-flan-repl--press "RET")
    (test-flan--check "a recalled multi-line form is sent whole"
                      (equal sent "(defn f [x]\n  (+ x 1))")))
  (test-flan-repl--done buf))

;;; The file between sessions

(let ((buf (test-flan-repl--buffer '("(+ 1 2)" "(defn f [x]\n  (+ x 1))"))))
  (with-current-buffer buf (flan-repl--save-history))
  (test-flan-repl--done buf)
  (test-flan--check "the history file is written"
                    (file-readable-p test-flan-repl--history))
  (let ((buf (test-flan-repl--buffer)))
    (with-current-buffer buf
      (test-flan--check "a new session reads back what the last one typed"
                        (and (= (ring-length comint-input-ring) 2)
                             (equal (ring-ref comint-input-ring 1) "(+ 1 2)")))
      ;; Comint separates entries with a newline, which is also what is inside
      ;; a form typed over several lines; with that separator this entry comes
      ;; back as two broken ones.
      (test-flan--check "including a form written over several lines, in one piece"
                        (equal (ring-ref comint-input-ring 0)
                               "(defn f [x]\n  (+ x 1))"))
      (test-flan-repl--press "<up>")
      (test-flan--check "and up recalls it"
                        (equal (test-flan-repl--input) "(defn f [x]\n  (+ x 1))")))
    (test-flan-repl--done buf)))

(let ((buf (test-flan-repl--buffer)))
  (with-current-buffer buf
    (flan-repl--save-history)
    (test-flan--check "a session that typed nothing does not empty the file"
                      (= (flan-repl--history-entries test-flan-repl--history) 2)))
  (test-flan-repl--done buf))

(let ((buf (test-flan-repl--buffer)))
  (with-current-buffer buf
    ;; What a second Emacs having saved a longer history looks like from here.
    ;; A write replaces the file whole, so the short ring would throw the other
    ;; session away.
    (setq comint-input-ring (make-ring flan-repl-history-size))
    (ring-insert comint-input-ring "(only-this)")
    (flan-repl--save-history)
    (test-flan--check "nor does a ring shorter than the file replace it"
                      (= (flan-repl--history-entries test-flan-repl--history) 2)))
  (test-flan-repl--done buf))

(when (file-exists-p test-flan-repl--history)
  (delete-file test-flan-repl--history))

;; And the hook itself, which is what makes any of the above happen without
;; being asked: this is the only check that kills a REPL buffer the way a
;; person does.
(let* ((test-flan-repl--history
        (make-temp-name (expand-file-name "flan-repl-killed-"
                                          temporary-file-directory)))
       (buf (test-flan-repl--buffer '("(kept)"))))
  (kill-buffer buf)
  (test-flan--check "killing the prompt saves what was typed at it"
                    (= (flan-repl--history-entries test-flan-repl--history) 1))
  (when (file-exists-p test-flan-repl--history)
    (delete-file test-flan-repl--history)))

(provide 'test-flan-repl)
;;; test-flan-repl.el ends here