;;; flan-repl.el --- A prompt for a running Flan program  -*- lexical-binding: t; -*-

;; A buffer to type expressions at, sent to the program `flan dev' is running
;; and answered with the value they had *there*.  It adds no protocol and no
;; compiler support: every line goes through the same `eval-expr' request that
;; C-x C-e uses.
;;
;; Derived from `comint-mode', for the same reason `flan-mode' derives from
;; `lisp-mode': history, the input ring, and kill/yank behaviour already exist
;; and are not worth rewriting.  There is no subprocess behind it — the
;; "process" is a stub comint needs in order to have a prompt at all.
;;
;; Two things about it that are decisions, not accidents:
;;
;; - **It is program-scoped.**  A name typed here resolves against the running
;;   program's top-level namespace, so in sand you write `sim/settle' and not
;;   `settle'.  A buffer visiting a package's own file gets the alias applied
;;   for it, because the file says which package it belongs to; a prompt has no
;;   file and nothing to derive it from.
;;
;; - **A value and the program's output are different things** and arrive by
;;   different routes.  The value of the expression appears at the prompt;
;;   anything the program printed while evaluating it goes to *flan-output*,
;;   riding along on the same reply.  Showing them in one place would be
;;   convenient and wrong.

;;; Code:

(require 'comint)
(require 'flan-mode)
(require 'flan-dev)

(defcustom flan-repl-buffer "*flan-repl*"
  "Name of the Flan REPL buffer."
  :type 'string
  :group 'flan)

(defvar flan-repl-prompt "flan> "
  "Prompt shown in `flan-repl-mode'.")

(defvar flan-repl-mode-map
  (let ((map (make-sparse-keymap)))
    (define-key map (kbd "C-c C-o") #'flan-show-output)
    (define-key map (kbd "C-c C-d") #'flan-describe)
    (define-key map (kbd "C-c C-q") #'flan-disconnect)
    map)
  "Keymap for `flan-repl-mode'.")

(define-derived-mode flan-repl-mode comint-mode "Flan-REPL"
  "Type expressions; they are evaluated in the running program.

\\{flan-repl-mode-map}"
  :syntax-table flan-mode-syntax-table
  (setq-local comint-prompt-regexp (concat "^" (regexp-quote flan-repl-prompt)))
  (setq-local comint-prompt-read-only t)
  (setq-local comint-input-sender #'flan-repl--send)
  ;; Nothing is echoed back by a process, because there is no process.
  (setq-local comint-process-echoes nil)
  ;; The prompt gets completion, eldoc and M-. for the same names a buffer
  ;; does, and against the same program: they read the client's cache, which
  ;; is program-scoped, which is exactly what a prompt is.
  (flan-dev-setup)
  (setq-local font-lock-defaults '(flan-font-lock-keywords)))

(defun flan-repl--complete-p (text)
  "Is TEXT a whole form?
Parens balanced and not inside a string or comment.  RET on a half-typed form
should open a line, not send something the reader will reject."
  (let ((state (with-temp-buffer
                 (set-syntax-table flan-mode-syntax-table)
                 (insert text)
                 (parse-partial-sexp (point-min) (point-max)))))
    (and (<= (nth 0 state) 0)            ; depth
         (not (nth 3 state))             ; in a string
         (not (nth 4 state)))))          ; in a comment

(defun flan-repl--output (text)
  "Insert TEXT into the REPL buffer above the next prompt."
  (let ((proc (get-buffer-process (current-buffer))))
    (comint-output-filter proc (concat text "\n" flan-repl-prompt))))

(defun flan-repl--send (_proc text)
  "Evaluate TEXT in the running program and show what it was."
  (let ((code (string-trim text)))
    (cond
     ((string-empty-p code) (flan-repl--output ""))
     (t
      (let ((reply (condition-case err
                       (flan-dev--request
                        (list :op "eval-expr" :code code :file "<repl>"))
                     (error (list :status "error"
                                  :message (error-message-string err))))))
        (flan-repl--output
         (if (equal (plist-get reply :status) "ok")
             (or (plist-get reply :value) "")
           (concat "error: " (or (plist-get reply :message) "rejected")
                   (let ((loc (plist-get reply :loc)))
                     (if loc (concat "  (" loc ")") ""))))))))))

(defun flan-repl-return ()
  "Send the input if it is a whole form, otherwise open a line."
  (interactive)
  (let ((input (buffer-substring-no-properties
                (process-mark (get-buffer-process (current-buffer)))
                (point-max))))
    (if (flan-repl--complete-p input)
        (comint-send-input)
      (insert "\n"))))

(define-key flan-repl-mode-map (kbd "RET") #'flan-repl-return)

;;;###autoload
(defun flan-repl ()
  "Open a prompt on the program `flan dev' is running.
Connects first if it has to."
  (interactive)
  (unless (and flan-dev--connection (process-live-p flan-dev--connection))
    (call-interactively #'flan-connect))
  (let ((buf (get-buffer-create flan-repl-buffer)))
    (with-current-buffer buf
      (unless (derived-mode-p 'flan-repl-mode)
        (flan-repl-mode)
        ;; comint wants a process to hang a prompt and a process mark off.
        ;; There is nothing to run, so this one does nothing and is never
        ;; written to; every request goes over the daemon's socket instead.
        (let ((proc (start-process "flan-repl" buf "cat")))
          (set-process-query-on-exit-flag proc nil)
          (comint-output-filter proc flan-repl-prompt))))
    (pop-to-buffer buf)))

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