;;; test-flan-fln.el --- The .fln mode, from written-out text  -*- lexical-binding: t; -*-

;; Loaded by test-flan-cider.el, which runs under `dune test', for the reason
;; test-flan-mode.el is: `emacs/*.el' is already that stanza's dependency.
;; Nothing here needs a daemon; what the daemon makes of what these commands
;; send is test-flan-fln-live.el's, run from test-flan.el.
;;
;; Every snippet is text; each check says where point is with a `|' written
;; into it, which is removed before the check runs.

;;; Code:

(require 'flan-fln-mode)
(require 'flan)

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

(defmacro test-flan-fln--in (text &rest body)
  "Run BODY in a .fln buffer holding TEXT, point where TEXT has its `|'."
  (declare (indent 1))
  `(with-temp-buffer
     (insert ,text)
     (flan-fln-mode)
     (goto-char (point-min))
     (when (search-forward "|" nil t)
       (delete-char -1))
     ,@body))

(defun test-flan-fln--text (b)
  (and b (cdr b) (buffer-substring-no-properties (car b) (cdr b))))

(defun test-flan-fln--is (name got want)
  (test-flan--check name (equal got want))
  (unless (equal got want)
    (message "       want %S\n       got  %S" want got)))

(defun test-flan-fln--thing (thing)
  (test-flan-fln--text (bounds-of-thing-at-point thing)))

(message "\nthe .fln mode")

;;; One parent

(test-flan--check "flan-mode is a flan-base-mode"
                  (provided-mode-derived-p 'flan-mode 'flan-base-mode))
(test-flan--check "flan-fln-mode is a flan-base-mode"
                  (provided-mode-derived-p 'flan-fln-mode 'flan-base-mode))
(test-flan--check ".fln opens in flan-fln-mode"
                  (eq (cdr (assoc "\\.fln\\'" auto-mode-alist)) 'flan-fln-mode))
(test-flan-fln--in "fn f() -> i32 = 1\n"
  (test-flan--check "a .fln buffer sends the indented syntax"
                    (equal (flan--syntax) "indented"))
  (test-flan--check "and gets the client's completion, as a .flan one does"
                    (memq #'flan-completion-at-point completion-at-point-functions))
  (test-flan--check "and the modeline indicator"
                    (member '(:eval (flan-mode-line)) mode-line-misc-info))
  (test-flan--check "the shared keys reach it through the parent's map"
                    (eq (key-binding (kbd "C-c C-b")) 'flan-cnr-show))
  (test-flan--check "and its own keys pick .fln forms"
                    (and (eq (key-binding (kbd "C-c C-c")) 'flan-fln-eval-defun)
                         (eq (key-binding (kbd "C-x C-e")) 'flan-fln-eval-last))))
(require 'flan-watch)
(let ((b (generate-new-buffer "ghost.fln")))
  (with-current-buffer b (flan-fln-mode))
  (switch-to-buffer b)
  (test-flan--check "watch paints ghost text in a shown .fln buffer"
                    (memq b (flan-watch--ghost-buffers)))
  (with-current-buffer b
    (insert "fn f() -> ()\n  watch-i64(\"x\", 1)\n")
    (test-flan--check "and finds a watch call written as a .fln call"
                      (equal (mapcar #'car (flan-watch--ghost-sites)) '("x"))))
  (kill-buffer b))
(require 'flan-dape)
(test-flan--check "dape offers its config in any Flan buffer"
                  (equal (plist-get flan-dape-config 'modes) '(flan-base-mode)))
(let ((buffer-file-name "/tmp/x.fln"))
  (test-flan--check "and debugs the .fln file it was started from"
                    (equal (flan-dape--source) "/tmp/x.fln")))

;;; The objects

(defconst test-flan-fln--settle
  "fn settle(row: i32, col: i32) -> ()
  let vel = f32(gravity) + velocity[row, col]
  while y > row
    if 0 == grid[y, col]
      grid[y, col] = grid[row, col]
      ; a comment inside the body

      return
    let left? = col > 0
      if left? or right?
        let side =
          if not left?
            1
          elif not right?
            -1
          else
            if f32(rand()) < 0.5 then 1 else -1
        grid[y, col + side] = grid[row, col]
    y = y - 1
  velocity[row, col] = 0.0

  ; trailing comment, not part of the function

fn step() -> ()
  paint-at(i32(m.y) / cell-size,
           i32(m.x) / cell-size)
  if r >= 0 and r < rows - 1
     and c >= 0
    grid[r, c] = 1
  step()
")

(defun test-flan-fln--at (text needle)
  "TEXT with a `|' before the first NEEDLE."
  (let ((i (string-search needle text)))
    (concat (substring text 0 i) "|" (substring text i))))

(test-flan-fln--in (test-flan-fln--at test-flan-fln--settle "if 0 == grid")
  (test-flan-fln--is "a statement takes its body, through blank and comment lines"
                     (test-flan-fln--thing 'flan-fln-statement)
                     "if 0 == grid[y, col]
      grid[y, col] = grid[row, col]
      ; a comment inside the body

      return")
  (test-flan-fln--is "its body is the lines under its first"
                     (test-flan-fln--thing 'flan-fln-body)
                     "grid[y, col] = grid[row, col]
      ; a comment inside the body

      return"))

(test-flan-fln--in (test-flan-fln--at test-flan-fln--settle "elif not right")
  (test-flan-fln--is "on a clause, the statement is its header's, clauses and all"
                     (test-flan-fln--thing 'flan-fln-statement)
                     "if not left?
            1
          elif not right?
            -1
          else
            if f32(rand()) < 0.5 then 1 else -1")
  (test-flan-fln--is "and the clause is its own line and block"
                     (test-flan-fln--thing 'flan-fln-clause)
                     "elif not right?
            -1"))

(test-flan-fln--in (test-flan-fln--at test-flan-fln--settle "1\n          elif")
  (test-flan-fln--is "a clause is not found from the header's own block"
                     (test-flan-fln--thing 'flan-fln-clause) nil))

(test-flan-fln--in (test-flan-fln--at test-flan-fln--settle "if f32(rand())")
  (test-flan-fln--is "from inside else's block, the clause is the else"
                     (test-flan-fln--thing 'flan-fln-clause)
                     "else
            if f32(rand()) < 0.5 then 1 else -1"))

(test-flan-fln--in (test-flan-fln--at test-flan-fln--settle "let side =")
  (test-flan-fln--is "let x = with the value as a block"
                     (test-flan-fln--thing 'flan-fln-statement)
                     "let side =
          if not left?
            1
          elif not right?
            -1
          else
            if f32(rand()) < 0.5 then 1 else -1"))

(test-flan-fln--in (test-flan-fln--at test-flan-fln--settle "i32(m.x)")
  (test-flan-fln--is "a line inside a bracket is part of its statement"
                     (test-flan-fln--thing 'flan-fln-statement)
                     "paint-at(i32(m.y) / cell-size,
           i32(m.x) / cell-size)")
  (test-flan-fln--is "a term is glued, brackets and all"
                     (test-flan-fln--thing 'flan-fln-term) "i32(m.x)")
  (test-flan-fln--is "a group is a bracket pair"
                     (test-flan-fln--thing 'flan-fln-group)
                     "(i32(m.y) / cell-size,
           i32(m.x) / cell-size)"))

(test-flan-fln--in (test-flan-fln--at test-flan-fln--settle "and c >= 0")
  (test-flan-fln--is "an operator continuation line is part of its statement"
                     (test-flan-fln--thing 'flan-fln-statement)
                     "if r >= 0 and r < rows - 1
     and c >= 0
    grid[r, c] = 1")
  (test-flan-fln--is "and not the start of the body"
                     (test-flan-fln--thing 'flan-fln-body) "grid[r, c] = 1"))

(test-flan-fln--in (test-flan-fln--at test-flan-fln--settle "velocity[row, col] = 0.0")
  (test-flan-fln--is "a top-level form ends before trailing comment lines"
                     (test-flan-fln--thing 'flan-fln-toplevel)
                     (substring test-flan-fln--settle 0
                                (+ (string-search "= 0.0" test-flan-fln--settle) 5))))

(test-flan-fln--in (test-flan-fln--at test-flan-fln--settle "trailing comment")
  (test-flan--check "a comment between forms belongs to the form above"
                    (string-prefix-p "fn settle"
                                     (test-flan-fln--thing 'flan-fln-toplevel))))

(test-flan-fln--in "; a header comment\n|\nfn f() -> i32 = 1\n"
  (test-flan-fln--is "before any form, the next one"
                     (test-flan-fln--thing 'flan-fln-toplevel) "fn f() -> i32 = 1"))

(test-flan-fln--in "def xs = [1 2\n3 4]\n  + 1\nfn|x() -> i32 = 1\n"
  (test-flan-fln--is "column 0 inside a bracket or after a leading operator is no form start"
                     (save-excursion (beginning-of-defun)
                                     (buffer-substring-no-properties (point) (line-end-position)))
                     "fnx() -> i32 = 1"))

(test-flan-fln--in "x = 1\nhandler-case\n  f()\non E(c)\n  nil\n|restart y\n"
  (test-flan--check "on and restart at column 0 are clauses, not forms"
                    (progn (beginning-of-defun)
                           (looking-at "handler-case"))))

(test-flan-fln--in "let on = 3\nfoo(x):|\n  bar()\n"
  (test-flan-fln--is "a term ends before the trailing colon of a call's block"
                     (test-flan-fln--text (flan-fln--term-before (point))) "foo(x)"))

(test-flan-fln--in "f(\\(, \\) , x.y)|\n"
  (test-flan-fln--is "a character literal is not a bracket"
                     (test-flan-fln--text (flan-fln--term-before (point)))
                     "f(\\(, \\) , x.y)"))

;;; Top-level motion

(test-flan-fln--in (test-flan-fln--at test-flan-fln--settle "    y = y - 1")
  (beginning-of-defun)
  (test-flan--check "C-M-a goes to the form's first line" (looking-at "fn settle"))
  (end-of-defun)
  (test-flan--check "C-M-e goes past its last code line, not its trailing comment"
                    (save-excursion (forward-line -1)
                                    (looking-at "  velocity\\[row, col\\] = 0.0")))
  (end-of-defun)
  (test-flan--check "and the next C-M-e ends the next form"
                    (= (point) (point-max)))
  (goto-char (point-max))
  (beginning-of-defun)
  (test-flan--check "C-M-a from the end reaches the last form" (looking-at "fn step"))
  (mark-defun)
  (test-flan--check "C-M-h marks the form"
                    (let ((m (buffer-substring (region-beginning) (region-end))))
                      (and (string-prefix-p "fn step" (string-trim-left m "\n"))
                           (string-suffix-p "  step()\n" m)))))

;;; Statement motion

(test-flan-fln--in (test-flan-fln--at test-flan-fln--settle "    let left?")
  (flan-fln-backward-statement)
  (test-flan--check "M-a at a statement's start goes to the one before at its level"
                    (looking-at "if 0 == grid"))
  (flan-fln-backward-statement)
  (test-flan--check "and out to the owner when there is none" (looking-at "while y"))
  (flan-fln-forward-statement)
  (test-flan--check "M-e goes to the end of the statement, body and all"
                    (looking-back "y = y - 1" (line-beginning-position)))
  (flan-fln-forward-statement)
  (test-flan--check "and again, to the end of the next"
                    (looking-back "= 0.0" (line-beginning-position))))

(test-flan-fln--in (test-flan-fln--at test-flan-fln--settle "  -1")
  (flan-fln-up)
  (test-flan--check "C-M-u goes to the line that owns the block"
                    (looking-at "elif not right"))
  (flan-fln-up)
  (test-flan--check "and from there to its owner's" (looking-at "let side")))

(test-flan-fln--in (test-flan-fln--at test-flan-fln--settle "m.x)")
  (flan-fln-up)
  (test-flan--check "C-M-u inside a bracket goes to the bracket" (looking-at "(m.x)")))

;;; What each key sends

;; The request, captured where it leaves: the daemon's answer is the live
;; test's business, and here what matters is which text went out and where
;; it said the text starts.
(defvar test-flan-fln--sent nil)

(defmacro test-flan-fln--sending (&rest body)
  `(progn
     (setq test-flan-fln--sent nil)
     (cl-letf (((symbol-function 'flan--request)
                (lambda (form) (push form test-flan-fln--sent)
                  (list :status "ok" :value "0")))
               ((symbol-function 'pulse-momentary-highlight-region) #'ignore))
       ,@body)
     (car test-flan-fln--sent)))

(defun test-flan-fln--sent-code (req)
  (plist-get req :code))

(defconst test-flan-fln--prog
  "fn fib(n: i64) -> i64
  if n < 2
    n
  else
    fib(n - 1) + fib(n - 2)

comment():
  twice(4)
  let x = 3
  if x > 2
    twice(x)
  else
    0

fn twice(n: i64) -> i64 = n * 2
")

(test-flan-fln--in (test-flan-fln--at test-flan-fln--prog "fib(n - 1)")
  (test-flan--check "C-c C-s is the .fln stepper"
                    (eq (key-binding (kbd "C-c C-s")) 'flan-fln-step-defun))
  (let ((r (test-flan-fln--sending (flan-fln-step-defun))))
    (test-flan--check "which installs the fn at point to step through"
                      (and (equal (plist-get r :op) "eval")
                           (eq (plist-get r :step) t)
                           (string-prefix-p "fn fib" (test-flan-fln--sent-code r))
                           (string-suffix-p "fib(n - 2)" (test-flan-fln--sent-code r))))))
(test-flan-fln--in (test-flan-fln--at test-flan-fln--prog "twice(4)")
  (test-flan--check "and refuses what is not a declaration"
                    (condition-case nil
                        (progn (test-flan-fln--sending (flan-fln-step-defun)) nil)
                      (user-error t))))
(test-flan-fln--in (test-flan-fln--at test-flan-fln--prog "fib(n - 1)")
  (let ((r (test-flan-fln--sending (flan-fln-eval-defun))))
    (test-flan--check "C-c C-c inside a fn installs the whole fn"
                      (and (equal (plist-get r :op) "eval")
                           (string-suffix-p "fib(n - 1) + fib(n - 2)"
                                            (test-flan-fln--sent-code r))
                           (string-prefix-p "fn fib" (test-flan-fln--sent-code r))
                           (equal (plist-get r :syntax) "indented")))))

(test-flan-fln--in (test-flan-fln--at test-flan-fln--prog "twice(4)")
  (let ((r (test-flan-fln--sending (flan-fln-eval-defun))))
    (test-flan--check "C-c C-c on a column-0 call evaluates it"
                      (equal (plist-get r :op) "eval-expr"))))

(test-flan-fln--in (test-flan-fln--at test-flan-fln--prog "\n  let x")
  (let ((r (test-flan-fln--sending (flan-fln-eval-last))))
    (test-flan--check "C-x C-e at a line's end sends the statement ending there"
                      (and (equal (plist-get r :op) "eval-expr")
                           (equal (test-flan-fln--sent-code r) "twice(4)")
                           (equal (plist-get r :line) 8)
                           (equal (plist-get r :col) 3)))))

(test-flan-fln--in (test-flan-fln--at test-flan-fln--prog "\n  else\n    0")
  (let ((r (test-flan-fln--sending (flan-fln-eval-last))))
    (test-flan--check "the innermost one: the last line of a block, not the if"
                      (equal (test-flan-fln--sent-code r) "twice(x)"))))

(test-flan-fln--in (test-flan-fln--at test-flan-fln--prog "(4)")
  (let ((r (test-flan-fln--sending (flan-fln-eval-last))))
    (test-flan--check "C-x C-e inside a line sends the term before point"
                      (and (equal (test-flan-fln--sent-code r) "twice")
                           (equal (plist-get r :col) 3)))))

(test-flan-fln--in (test-flan-fln--at test-flan-fln--prog "\n\ncomment")
  (let ((r (test-flan-fln--sending (flan-fln-eval-last))))
    (test-flan--check "at the end of a fn's last line, the innermost statement, not the fn"
                      (equal (test-flan-fln--sent-code r) "fib(n - 1) + fib(n - 2)"))))

(test-flan-fln--in test-flan-fln--prog
  (goto-char (point-max))
  (skip-chars-backward "\n")
  (let ((r (test-flan-fln--sending (flan-fln-eval-last))))
    (test-flan--check "a column-0 one-line fn at its end is installed"
                      (and (equal (plist-get r :op) "eval")
                           (string-suffix-p "fn twice(n: i64) -> i64 = n * 2"
                                            (test-flan-fln--sent-code r))))))

(test-flan-fln--in (test-flan-fln--at test-flan-fln--prog "else\n    0")
  (let ((r (test-flan-fln--sending (flan-fln-eval-statement))))
    (test-flan--check "C-c C-e on a clause sends its whole statement"
                      (and (equal (test-flan-fln--sent-code r)
                                  "if x > 2\n    twice(x)\n  else\n    0")
                           (equal (plist-get r :line) 10)
                           (equal (plist-get r :col) 3)))))

(test-flan-fln--in (test-flan-fln--at test-flan-fln--prog "let x = 3")
  (let ((r (test-flan-fln--sending (flan-fln-eval-statement))))
    (test-flan--check "C-c C-e on a bare let sends it with the rest of its block"
                      (equal (test-flan-fln--sent-code r)
                             "let x = 3\n  if x > 2\n    twice(x)\n  else\n    0"))))

(test-flan-fln--in (test-flan-fln--at test-flan-fln--prog "twice(4)")
  (let ((r (test-flan-fln--sending (flan-fln-eval-statement-and-next))))
    (test-flan--check "C-c C-n sends the statement"
                      (equal (test-flan-fln--sent-code r) "twice(4)"))
    (test-flan--check "and moves to the next" (looking-at "let x = 3"))))

(test-flan-fln--in (test-flan-fln--at test-flan-fln--prog "twice(4)")
  (transient-mark-mode 1)
  (set-mark (point))
  (search-forward "twice(x)")
  (forward-char -3)
  (let ((r (test-flan-fln--sending (flan-fln-eval-statement))))
    (test-flan--check "C-c C-e sends the region's whole lines"
                      (equal (test-flan-fln--sent-code r)
                             "twice(4)\n  let x = 3\n  if x > 2\n    twice(x)"))))

;; The pause target.  The position sent is where the reader starts the form,
;; which for a call is its name and not its parenthesis; the live test checks
;; the daemon finds a form there.
(test-flan-fln--in (test-flan-fln--at test-flan-fln--prog "n - 1)")
  (let ((r (test-flan-fln--sending (flan-fln-eval-defun '(4)))))
    (test-flan-fln--is "C-u C-c C-c in a call marks the call, from its name"
                       (plist-get r :pause) '(5 5))))

(test-flan-fln--in (test-flan-fln--at test-flan-fln--prog "< 2")
  (let ((r (test-flan-fln--sending (flan-fln-eval-defun '(4)))))
    (test-flan-fln--is "outside a bracket, the statement on point's line"
                       (plist-get r :pause) '(2 3))))

(test-flan-fln--in (test-flan-fln--at test-flan-fln--prog "n < 2")
  (let ((r (test-flan-fln--sending (flan-fln-eval-defun '(16)))))
    (test-flan-fln--is "C-u C-u, the fn: stop on entry"
                       (plist-get r :pause) '(1 1))))

(test-flan-fln--in "fn f(x: i64) -> i64\n  g((x| + 1), [x 2])\n"
  (let ((r (test-flan-fln--sending (flan-fln-eval-defun '(4)))))
    (test-flan-fln--is "a free parenthesis marks the value inside it"
                       (plist-get r :pause) '(2 6))))

;;; Match arms, header lines, clauses, comments

(defconst test-flan-fln--arms
  "fn pick(n: i64) -> i64
  let r = match n
    0 -> 10
    1 ->
      twice(1)
      twice(2)
    k -> k + 1
  if n < 0
    -1
  elif n == 0
       or n == 1
    0
  else
    r
  handler-case
    f()
  on Error(e)
    nil
  ; a comment, twice(9)
  r

comment:
  twice(4)
")

(defun test-flan-fln--last-at (needle &optional fn)
  "What FN, C-x C-e by default, sends with point at the end of NEEDLE's line."
  (test-flan-fln--in (test-flan-fln--at test-flan-fln--arms needle)
    (end-of-line)
    (let ((r (test-flan-fln--sending (funcall (or fn #'flan-fln-eval-last)))))
      (and r (list (plist-get r :op) (test-flan-fln--sent-code r))))))

(test-flan-fln--is "C-x C-e at the end of a match arm sends its value"
                   (test-flan-fln--last-at "0 -> 10") '("eval-expr" "10"))
(test-flan-fln--is "at the end of an arm with a block, the block"
                   (test-flan-fln--last-at "1 ->")
                   '("eval-expr" "twice(1)\n      twice(2)"))
(test-flan-fln--is "an arm whose pattern binds a name sends the whole match"
                   (cadr (test-flan-fln--last-at "k -> k"))
                   (substring test-flan-fln--arms (string-search "let r" test-flan-fln--arms)
                              (+ (string-search "k + 1" test-flan-fln--arms) 5)))
(test-flan-fln--in (test-flan-fln--at test-flan-fln--arms "twice(2)")
  (test-flan-fln--is "C-c C-e on an arm's block sends the block, not the arm"
                     (test-flan-fln--sent-code
                      (test-flan-fln--sending
                       (search-backward "1 ->") (flan-fln-eval-statement)))
                     "twice(1)\n      twice(2)"))
(test-flan-fln--is "C-x C-e at the end of an if line sends its condition"
                   (test-flan-fln--last-at "if n < 0") '("eval-expr" "n < 0"))
(test-flan-fln--is "and of an elif, all of its condition"
                   (test-flan-fln--last-at "or n == 1")
                   '("eval-expr" "n == 0\n       or n == 1"))
(test-flan-fln--is "and the same from the end of the condition's first line"
                   (test-flan-fln--last-at "elif n == 0")
                   '("eval-expr" "n == 0\n       or n == 1"))

(defconst test-flan-fln--wrapped
  "fn f(o: Option(i64)) -> i64
  match o
    Some(_) -> 5
    Some(n) -> n + 1
    Some(m) -> 7
    None -> 1 +
            2
  if 1 < 2 and
     3 < 4
    x = 1 +
      2
")

(defun test-flan-fln--wrapped-at (needle fn)
  (test-flan-fln--in (test-flan-fln--at test-flan-fln--wrapped needle)
    (end-of-line)
    (let ((r (test-flan-fln--sending (funcall fn))))
      (and r (test-flan-fln--sent-code r)))))

(test-flan-fln--is "an arm's value wrapped onto a second line goes whole"
                   (test-flan-fln--wrapped-at "None" #'flan-fln-eval-last)
                   "1 +\n            2")
(test-flan-fln--is "from its second line too"
                   (test-flan-fln--wrapped-at "  2\n  if" #'flan-fln-eval-last)
                   "1 +\n            2")
(test-flan-fln--is "and C-c C-e on it sends the same"
                   (test-flan-fln--wrapped-at "None" #'flan-fln-eval-statement)
                   "1 +\n            2")
(test-flan-fln--is "a wrapped if condition, from the end of its first line"
                   (test-flan-fln--wrapped-at "if 1 < 2" #'flan-fln-eval-last)
                   "1 < 2 and\n     3 < 4")
(test-flan-fln--is "a statement wrapped by an operator, from the end of its first line"
                   (test-flan-fln--wrapped-at "x = 1 +" #'flan-fln-eval-last)
                   "x = 1 +\n      2")
(test-flan-fln--in (test-flan-fln--at test-flan-fln--wrapped "None")
  (end-of-line)
  (let ((r (test-flan-fln--sending (flan-fln-eval-last))))
    (test-flan-fln--is "a value cut mid-line says where its statement starts"
                       (list (plist-get r :line) (plist-get r :col) (plist-get r :indent))
                       '(6 13 5))))
(test-flan-fln--in (test-flan-fln--at test-flan-fln--wrapped "x = 1")
  (end-of-line)
  (let ((r (test-flan-fln--sending (flan-fln-eval-last))))
    (test-flan--check "a whole statement does not" (null (plist-member r :indent)))))
(test-flan-fln--is "an arm whose pattern binds nothing sends its value"
                   (test-flan-fln--wrapped-at "Some(_)" #'flan-fln-eval-last) "5")
(test-flan-fln--is "nor one whose value does not use what it binds"
                   (test-flan-fln--wrapped-at "Some(m)" #'flan-fln-eval-last) "7")
(dolist (c '(("Some(_v) -> _v + 1" "a name starting with _")
             ("Some(éé) -> éé" "a name that is not ASCII")
             ("Some(N) -> N" "a capitalised name")
             ("Some(p) -> p.x" "a name used as a field's base")
             ("Some(n) -> -n" "a name its value negates")
             ("Some(p) -> -p.x" "a name whose field its value negates")))
  (test-flan-fln--in (concat "fn f(o: Option(i64)) -> i64\n  match o\n    " (car c) "\n")
    (goto-char (point-max))
    (skip-chars-backward "\n")
    (test-flan--check (format "an arm binding %s its value uses sends the match" (cadr c))
                      (string-prefix-p "match o"
                                       (test-flan-fln--sent-code
                                        (test-flan-fln--sending (flan-fln-eval-last)))))))
(test-flan--check "one whose value uses its binding sends the match"
                  (string-prefix-p "match o"
                                   (test-flan-fln--wrapped-at "Some(n)" #'flan-fln-eval-last)))
(test-flan-fln--in (test-flan-fln--at test-flan-fln--wrapped "5")
  (test-flan-fln--is "a match arm is a clause"
                     (test-flan-fln--thing 'flan-fln-clause) "Some(_) -> 5"))
(test-flan-fln--is "at the end of an else line, the whole if"
                   (cadr (test-flan-fln--last-at "else\n    r"))
                   "if n < 0\n    -1\n  elif n == 0\n       or n == 1\n    0\n  else\n    r")
(test-flan-fln--is "at the end of an on line, the whole handler-case"
                   (cadr (test-flan-fln--last-at "on Error"))
                   "handler-case\n    f()\n  on Error(e)\n    nil")
(test-flan-fln--is "at the end of a fn header, the fn, installed"
                   (car (test-flan-fln--last-at "fn pick")) "eval")
(test-flan-fln--is "at the end of comment:, the whole block"
                   (test-flan-fln--last-at "comment:")
                   '("eval-expr" "comment:\n  twice(4)"))
(test-flan-fln--in (test-flan-fln--at test-flan-fln--arms "; a comment")
  (end-of-line)
  (let ((r (test-flan-fln--sending
            (condition-case nil (flan-fln-eval-last) (user-error nil)))))
    (test-flan--check "C-x C-e on a comment line sends nothing from the comment"
                      (null r))))

(defun test-flan-fln--pause-at (needle)
  (test-flan-fln--in (test-flan-fln--at test-flan-fln--arms needle)
    (plist-get (test-flan-fln--sending (flan-fln-eval-defun '(4))) :pause)))

(test-flan-fln--is "C-u C-c C-c on an arm's pattern stops at its value"
                   (test-flan-fln--pause-at "0 -> 10") '(3 10))
(test-flan-fln--is "on an arm with a block, at the block"
                   (test-flan-fln--pause-at "1 ->") '(5 7))
(test-flan-fln--is "on an elif line, at its condition"
                   (test-flan-fln--pause-at "elif") '(10 8))
(test-flan-fln--is "and from its condition's continuation line too"
                   (test-flan-fln--pause-at "or n == 1") '(10 8))
(test-flan-fln--is "on an else line, at its block"
                   (test-flan-fln--pause-at "else\n    r") '(14 5))
(test-flan-fln--is "on an on line, at its block"
                   (test-flan-fln--pause-at "on Error") '(18 5))

;;; Names and colours

(test-flan-fln--in "fn f(x: i64) -> i64\n  comment:\n    g(:key-r, x)\n  0x1F + 12\n"
  (search-forward "x:")
  (backward-char 1)
  (test-flan-fln--is "a colon glued to a name is not part of it"
                     (thing-at-point 'symbol t) "x")
  (search-forward "comment")
  (test-flan-fln--is "nor to a name that takes a block"
                     (thing-at-point 'symbol t) "comment")
  (test-flan--check "font-lock draws the buffer without an error"
                    (condition-case nil (progn (font-lock-ensure) t) (error nil)))
  (let ((face (lambda (needle)
                (save-excursion (goto-char (point-min)) (search-forward needle)
                                (get-text-property (match-beginning 0) 'face)))))
    (test-flan-fln--is "a number is drawn as one" (funcall face "12") 'font-lock-number-face)
    (test-flan-fln--is "a keyword as a constant" (funcall face ":key-r") 'font-lock-constant-face)
    (test-flan-fln--is "a header word as a keyword" (funcall face "fn") 'font-lock-keyword-face)
    (test-flan-fln--is "a type after its colon" (funcall face "i64") 'font-lock-type-face)
    (test-flan--check "and the name before the colon is not a keyword"
                      (null (funcall face "x:")))))

;;; Indentation

(defun test-flan-fln--tabs (text n)
  "The column TEXT's `|' line reaches after N TABs."
  (test-flan-fln--in text
    (let ((last-command nil) (this-command 'indent-for-tab-command))
      (dotimes (_ n)
        (indent-for-tab-command)
        (setq last-command 'indent-for-tab-command)))
    (current-indentation)))

(defconst test-flan-fln--nest
  "fn f() -> ()
  while a
    if b
      c()
|")

(test-flan-fln--is "the first TAB after a block goes to its column"
                   (test-flan-fln--tabs test-flan-fln--nest 1) 6)
(test-flan-fln--is "each TAB after that steps out one"
                   (list (test-flan-fln--tabs test-flan-fln--nest 2)
                         (test-flan-fln--tabs test-flan-fln--nest 3)
                         (test-flan-fln--tabs test-flan-fln--nest 4)
                         (test-flan-fln--tabs test-flan-fln--nest 5))
                   '(4 2 0 6))
(test-flan-fln--is "a line of code already at a valid column stays there"
                   (test-flan-fln--tabs "fn f() -> ()\n  if a\n    b\n|  let b = 2" 1) 2)
(test-flan-fln--is "and a second TAB steps it out"
                   (test-flan-fln--tabs "fn f() -> ()\n  if a\n    b\n|  let b = 2" 2) 0)
(test-flan-fln--is "a line of code at no valid column goes to the deepest"
                   (test-flan-fln--tabs "fn f() -> ()\n  if a\n    b\n|   let b = 2" 1) 4)
(test-flan-fln--is "after a header, one level deeper first"
                   (test-flan-fln--tabs "fn f() -> ()\n  while a\n|" 1) 4)
(test-flan-fln--is "after a trailing colon too"
                   (test-flan-fln--tabs "rl/with-drawing():\n|" 1) 2)
(test-flan-fln--is "and after let x ="
                   (test-flan-fln--tabs "def colors =\n|" 1) 2)
(test-flan-fln--is "but not after a one-line fn"
                   (test-flan-fln--tabs "fn f() -> i32 = 1\n|" 1) 0)
(test-flan-fln--is "else goes to its if's column, whatever the depth"
                   (test-flan-fln--tabs "if a\n  if b\n    c\n      |else" 1) 2)
(test-flan-fln--is "and a second TAB to the outer if's"
                   (test-flan-fln--tabs "if a\n  if b\n    c\n      |else" 2) 0)
(test-flan-fln--is "on goes to its handler-case's"
                   (test-flan-fln--tabs "  handler-case\n    f()\n    |on E(c)" 1) 2)
(test-flan-fln--is "inside a call, under its first argument"
                   (test-flan-fln--tabs "  paint-at(i32(m.y) / cell-size,\n|i32(m.x))" 1) 11)
(test-flan-fln--is "inside a bracket with nothing after it, one level in"
                   (test-flan-fln--tabs "  let v = [\n|1 2]" 1) 4)
(test-flan-fln--is "a closing bracket, at its opening line's column"
                   (test-flan-fln--tabs "  let v = [\n    1 2\n|]" 1) 2)
(test-flan-fln--is "after a line ending in an operator, deeper than its statement"
                   (test-flan-fln--tabs "  if a and\n|b" 1) 4)

(test-flan-fln--in "fn f() -> ()\n  while a\n    b()\n    |"
  (flan-fln-dedent-or-delete 1)
  (test-flan-fln--is "backspace in the indentation drops one level"
                     (current-indentation) 2)
  (flan-fln-dedent-or-delete 1)
  (test-flan-fln--is "and another" (current-indentation) 0))

(test-flan-fln--in "fn f() -> ()\n  ab|"
  (flan-fln-dedent-or-delete 1)
  (test-flan-fln--is "backspace after text deletes a character"
                     (buffer-substring (line-beginning-position) (point)) "  a"))

(test-flan-fln--in "if a\n  if b\n    c\n    els|"
  (let ((last-command-event ?e))
    (insert "e")
    (run-hooks 'post-self-insert-hook))
  (let ((last-command-event ?\s))
    (insert " ")
    (run-hooks 'post-self-insert-hook))
  (test-flan-fln--is "else snaps to its if as it is typed"
                     (current-indentation) 2))

(test-flan-fln--in "fn f() -> ()\n  if a\n    b\n|      c\n        d\n"
  (indent-region (point) (point-max))
  (test-flan-fln--is "indent-region moves a block rigidly"
                     (buffer-substring (point) (point-max))
                     "    c\n      d\n"))

(test-flan-fln--in "fn f() -> ()\n  if a\n    b\n  |c\n"
  (indent-region (point-min) (point-max))
  (test-flan-fln--is "and leaves lines at valid columns alone"
                     (buffer-string) "fn f() -> ()\n  if a\n    b\n  c\n"))

(test-flan-fln--in "fn f() -> ()\n  if a\n    b\n  |\n"
  (kill-new "if x\n    y\n  else\n    z")
  (flan-fln-yank)
  (test-flan-fln--is "a statement cut from its first character yanks as one block"
                     (buffer-string)
                     "fn f() -> ()\n  if a\n    b\n  if x\n    y\n  else\n    z\n"))

(test-flan-fln--in "fn f() -> ()\n  if a\n    |\n"
  (kill-new "  while x\n    y\n")
  (flan-fln-yank)
  (test-flan-fln--is "whole lines yank at point's column"
                     (buffer-string)
                     "fn f() -> ()\n  if a\n    while x\n      y\n\n"))

;;; Block editing

(test-flan-fln--in "fn f() -> ()\n  if a\n    |b()\n  c()\n  d()\n"
  (flan-fln-slurp)
  (test-flan-fln--is "slurp pulls the next statement into the block"
                     (buffer-string) "fn f() -> ()\n  if a\n    b()\n    c()\n  d()\n")
  (flan-fln-barf)
  (test-flan-fln--is "barf pushes the last one out again"
                     (buffer-string) "fn f() -> ()\n  if a\n    b()\n  c()\n  d()\n"))

(test-flan-fln--in "fn f() -> ()\n  |a()\n  if x\n    y\n  b()\n"
  (flan-fln-move-statement-down)
  (test-flan-fln--is "a statement moves down past its sibling's whole block"
                     (buffer-string) "fn f() -> ()\n  if x\n    y\n  a()\n  b()\n")
  (test-flan--check "and point moves with it" (looking-at "a()"))
  (flan-fln-move-statement-up)
  (test-flan-fln--is "and back up"
                     (buffer-string) "fn f() -> ()\n  a()\n  if x\n    y\n  b()\n"))

(test-flan-fln--in "fn f() -> ()\n  when(c):\n    if x\n      |y\n"
  (flan-fln-raise-statement)
  (test-flan-fln--is "raise replaces the owner with the statement"
                     (buffer-string) "fn f() -> ()\n  when(c):\n    y\n"))

(test-flan-fln--in "fn f() -> ()\n  |if x\n    y\n  else\n    z\n  b()\n"
  (flan-fln-kill-statement)
  (test-flan-fln--is "kill takes the whole statement's lines"
                     (buffer-string) "fn f() -> ()\n  b()\n")
  (test-flan-fln--is "into the kill ring" (current-kill 0)
                     "  if x\n    y\n  else\n    z\n"))

;;; expand-region, where it is installed

(let* ((dirs (append (file-expand-wildcards "~/.config/emacs/elpa/expand-region-[0-9]*")
                     (file-expand-wildcards "~/.emacs.d/elpa/expand-region-[0-9]*")))
       (load-path (append dirs load-path)))
  (if (not (require 'expand-region nil t))
      (message "  skip expand-region (not installed)")
    (test-flan-fln--in (test-flan-fln--at test-flan-fln--settle "right?\n            -1")
      (transient-mark-mode 1)
      (let ((steps nil))
        (dotimes (_ 6)
          (er/expand-region 1)
          (push (buffer-substring-no-properties (region-beginning) (region-end)) steps))
        (setq steps (nreverse steps))
        (test-flan-fln--is "term, then statement's clause, then statement, then out"
                           (mapcar (lambda (s) (car (split-string s "\n"))) steps)
                           '("right?" "elif not right?" "if not left?" "let side ="
                             "if left? or right?" "let left? = col > 0"))))))

;;; smartparens, where it is installed

(let* ((dirs (append (file-expand-wildcards "~/.config/emacs/elpa/smartparens-[0-9]*")
                     (file-expand-wildcards "~/.emacs.d/elpa/smartparens-[0-9]*")
                     (file-expand-wildcards "~/.config/emacs/elpa/dash-[0-9]*")
                     (file-expand-wildcards "~/.emacs.d/elpa/dash-[0-9]*")))
       (load-path (append dirs load-path)))
  (if (not (require 'smartparens nil t))
      (message "  skip smartparens (not installed)")
    ;; A setup that puts sexp commands on the top-level keys, as the
    ;; author's does.
    (define-key smartparens-mode-map (kbd "C-M-a") 'sp-backward-down-sexp)
    (define-key smartparens-mode-map (kbd "C-M-u") 'sp-backward-up-sexp)
    (let ((b (generate-new-buffer "sp.fln")))
      (switch-to-buffer b)
      (flan-fln-mode)
      (test-flan--check "smartparens is on in a .fln buffer" smartparens-mode)
      (test-flan--check "and C-M-a and C-M-u stay the mode's"
                        (and (eq (key-binding (kbd "C-M-a")) 'beginning-of-defun)
                             (eq (key-binding (kbd "C-M-u")) 'flan-fln-up)))
      (execute-kbd-macro "f(")
      (test-flan-fln--is "it pairs a bracket" (buffer-string) "f()")
      (erase-buffer)
      (execute-kbd-macro "'a")
      (test-flan-fln--is "and not a quote" (buffer-string) "'a")
      (set-buffer-modified-p nil)
      (kill-buffer b))
    (define-key smartparens-mode-map (kbd "C-M-a") nil)
    (define-key smartparens-mode-map (kbd "C-M-u") nil)))

;;; Under Evil

(let* ((dirs (append (file-expand-wildcards "~/.config/emacs/elpa/evil-[0-9]*")
                     (file-expand-wildcards "~/.emacs.d/elpa/evil-[0-9]*")
                     (file-expand-wildcards "~/.config/emacs/elpa/goto-chg-*")
                     (file-expand-wildcards "~/.emacs.d/elpa/goto-chg-*")))
       (load-path (append dirs load-path)))
  (if (not (require 'evil nil t))
      (message "  skip the .fln text objects (Evil is not installed)")
    (evil-mode 1)
    (unwind-protect
        (let ((yanked
               (lambda (text keys)
                 (let ((b (generate-new-buffer "objects.fln")))
                   (switch-to-buffer b)
                   (insert text)
                   (flan-fln-mode)
                   (evil-initialize-state)
                   (evil-normal-state)
                   (goto-char (point-min))
                   (search-forward "|")
                   (delete-char -1)
                   (execute-kbd-macro keys)
                   (prog1 (substring-no-properties (current-kill 0))
                     (set-buffer-modified-p nil)
                     (kill-buffer b))))))
          (dolist (c `(("yiw" ,(test-flan-fln--at test-flan-fln--settle "settle(")
                        "settle")
                       ("yie" ,(test-flan-fln--at test-flan-fln--settle "i32(m.x)")
                        "i32(m.x)")
                       ("yis" ,(test-flan-fln--at test-flan-fln--settle "and c >= 0")
                        "if r >= 0 and r < rows - 1\n     and c >= 0\n    grid[r, c] = 1")
                       ("yas" ,(test-flan-fln--at test-flan-fln--settle "and c >= 0")
                        "  if r >= 0 and r < rows - 1\n     and c >= 0\n    grid[r, c] = 1\n")
                       ("yii" ,(test-flan-fln--at test-flan-fln--settle "if not left")
                        "            1\n")
                       ("yik" ,(test-flan-fln--at test-flan-fln--settle "if f32(rand())")
                        "            if f32(rand()) < 0.5 then 1 else -1\n")
                       ("yak" ,(test-flan-fln--at test-flan-fln--settle "if f32(rand())")
                        "          else\n            if f32(rand()) < 0.5 then 1 else -1\n")
                       ("yik" ,(test-flan-fln--at test-flan-fln--wrapped "Some(_)")
                        "5")
                       ("yak" ,(test-flan-fln--at test-flan-fln--wrapped "Some(_)")
                        "    Some(_) -> 5\n")
                       ("yid" ,(test-flan-fln--at test-flan-fln--settle "paint-at")
                        ,(substring test-flan-fln--settle
                                    (string-search "fn step" test-flan-fln--settle)))))
            (test-flan-fln--is (format "under Evil, %s" (car c))
                               (funcall yanked (nth 1 c) (car c)) (nth 2 c)))
          (let ((deleted
                 (lambda (keys needle)
                   (let ((b (generate-new-buffer "delete.fln")))
                     (switch-to-buffer b)
                     (insert "fn f(x: i64) -> i64\n  if x > 0\n    a\n  else\n    3\n  x\n\nfn g() -> i32 = 1\n")
                     (flan-fln-mode)
                     (evil-initialize-state)
                     (evil-normal-state)
                     (goto-char (point-min))
                     (search-forward needle)
                     (goto-char (match-beginning 0))
                     (execute-kbd-macro keys)
                     (prog1 (buffer-string)
                       (set-buffer-modified-p nil)
                       (kill-buffer b))))))
            (dolist (c '(("dak" "else"
                          "fn f(x: i64) -> i64\n  if x > 0\n    a\n  x\n\nfn g() -> i32 = 1\n")
                         ("das" "else"
                          "fn f(x: i64) -> i64\n  x\n\nfn g() -> i32 = 1\n")
                         ("dii" "if x"
                          "fn f(x: i64) -> i64\n  if x > 0\n  else\n    3\n  x\n\nfn g() -> i32 = 1\n")
                         ("dad" "else" "fn g() -> i32 = 1\n")
                         ("dad" "fn g" "fn f(x: i64) -> i64\n  if x > 0\n    a\n  else\n    3\n  x\n")))
              (test-flan-fln--is (format "under Evil, %s leaves no blank line" (car c))
                                 (funcall deleted (car c) (nth 1 c)) (nth 2 c))))
          ;; Comments: a block directly on a form is the form's; one a
          ;; blank line away, or below it, is not.
          (let ((deleted
                 (lambda (keys needle)
                   (let ((b (generate-new-buffer "comments.fln")))
                     (switch-to-buffer b)
                     (insert "; loose\n\n; on f\nfn f() -> ()\n  a()\n; after f\n\n"
                             "; on g\nfn g() -> ()\n  ; on b\n  b()\n")
                     (flan-fln-mode)
                     (evil-initialize-state)
                     (evil-normal-state)
                     (goto-char (point-min))
                     (search-forward needle)
                     (goto-char (match-beginning 0))
                     (execute-kbd-macro keys)
                     (prog1 (buffer-string)
                       (set-buffer-modified-p nil)
                       (kill-buffer b))))))
            (dolist (c '(("dad" "a()"
                          "; loose\n\n; after f\n\n; on g\nfn g() -> ()\n  ; on b\n  b()\n")
                         ("dad" "b()"
                          "; loose\n\n; on f\nfn f() -> ()\n  a()\n; after f\n")
                         ("did" "on g"
                          "; loose\n\n; on f\nfn f() -> ()\n  a()\n; after f\n\n")
                         ("das" "b()"
                          "; loose\n\n; on f\nfn f() -> ()\n  a()\n; after f\n\n; on g\nfn g() -> ()\n")))
              (test-flan-fln--is (format "under Evil, %s on %s keeps comments with their forms"
                                         (car c) (nth 1 c))
                                 (funcall deleted (car c) (nth 1 c)) (nth 2 c)))
            ;; A lone comment belongs to no form: id and ad find nothing.
            (dolist (text '("fn a() -> i64\n  1\n\n; lone\n\nfn b() -> i64\n  2\n"
                            "fn a() -> i64\n  1\n\n; lone\n"))
              (dolist (keys '("did" "dad"))
                (let ((b (generate-new-buffer "lone.fln")))
                  (switch-to-buffer b)
                  (insert text)
                  (flan-fln-mode)
                  (evil-initialize-state)
                  (evil-normal-state)
                  (goto-char (point-min))
                  (search-forward "; lone")
                  (goto-char (match-beginning 0))
                  (ignore-errors (execute-kbd-macro keys))
                  (test-flan-fln--is (format "under Evil, %s on a lone comment%s changes nothing"
                                             keys (if (string-suffix-p "lone\n" text) " at the end" ""))
                                     (buffer-string) text)
                  (set-buffer-modified-p nil)
                  (kill-buffer b))))
            ;; A comment deeper than a form, at the end of its block, is
            ;; that block's, not the next form's.
            (dolist (c '(("dad" "fn a" "fn a() -> i64\n  1\n  ; end of a\nfn b() -> i64\n  2\n"
                          "fn b() -> i64\n  2\n")
                         ("dad" "fn b" "fn a() -> i64\n  1\n  ; end of a\nfn b() -> i64\n  2\n"
                          "fn a() -> i64\n  1\n  ; end of a\n")
                         ("das" "let y"
                          "fn a(x: i64) -> i64\n  if x > 0\n    1\n    ; end of the if\n  let y = 2\n  y\n"
                          "fn a(x: i64) -> i64\n  if x > 0\n    1\n    ; end of the if\n  y\n")))
              (let ((b (generate-new-buffer "owned.fln")))
                (switch-to-buffer b)
                (insert (nth 2 c))
                (flan-fln-mode)
                (evil-initialize-state)
                (evil-normal-state)
                (goto-char (point-min))
                (search-forward (nth 1 c))
                (goto-char (match-beginning 0))
                (execute-kbd-macro (car c))
                (test-flan-fln--is (format "under Evil, %s on %s: a deeper comment stays with the block above"
                                           (car c) (nth 1 c))
                                   (buffer-string) (nth 3 c))
                (set-buffer-modified-p nil)
                (kill-buffer b))))
          (let ((b (generate-new-buffer "keys.fln")))
            (switch-to-buffer b)
            (insert "fn f() -> i32 = 1\n")
            (flan-fln-mode)
            (evil-initialize-state)
            (test-flan--check "under Evil, C-x C-e is still the mode's"
                              (eq (key-binding (kbd "C-x C-e")) 'flan-fln-eval-last))
            (goto-char (point-min))
            (end-of-line)
            (backward-char)
            (test-flan--check "under Evil, C-x C-e counts the cursor's character"
                              (= (flan-fln--point-for-last) (line-end-position)))
            (kill-buffer b)))
      (evil-mode -1))))

;;; test-flan-fln.el ends here