;;; test-flan-fln-live.el --- The .fln keys against a real daemon  -*- lexical-binding: t; -*-

;; Loaded by test-flan.el, near its end, with `flan-command' already the
;; compiler under test.  test-flan-fln.el checks which text each key picks;
;; this checks the reader accepts that text as a whole form, on both backends:
;; a daemon of its own on a .fln file with no main, once on x86 and once on
;; LLVM, each key sent at least once, and a pause mark the daemon must find.

;;; Code:

(require 'flan-fln-mode)

(declare-function test-flan--check "test-flan" (name ok))
(declare-function test-flan--result "test-flan" ())
(defvar test-flan-fln-live-dir)
(defvar test-flan-fln-live-socket)

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

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

fn total(n: i32) -> i32
  let t = 0
  for i in range(n)
    t = t + i
  t

fn sign(n: i64) -> i64
  if n < 0
    -1
  elif n == 0
    0
  else
    1

enum Dir
  north
  south
  east

fn pick(d: Dir) -> i64
  match d
    :north -> 10
    :south -> 20
    :east -> 1 +
             2
    _ ->
      twice(3)

fn sign2(k: i64)
  if k < 0 then -1
  elif k == 0 then 0
  else 1

fn size(k: i64) -> i64
  if k < 10
    1
  else 2

fn lam(k: i64) -> i64
  let add = fn(a: i64, b: i64) -> i64 => a + b
  let dbl = fn(a: i64) -> i64 =>
    a * 2
  add(dbl(k), 1)

fn app(x: i64, f: Fn(i64) -> i64) -> i64 = f(x)

fn lam2(k: i64) -> i64
  let a = 1
  let b = app(k, fn(x) =>
    let y = x + a
    y)
  let c = fn(z: i64) -> i64 =>
    z * 2
  c(b)

fn rs() -> i64
  restart-case
    3
  restart retry() \"Try again\"
    4

fn t2(k: i64) -> i64
  let a = 1
  let b = 2
  let c: i64 = 3
  a + b + c + k

fn dir(d: Dir) -> i64
  match d
    Dir.north -> 7
    _ -> 8

struct Oops :parent Error
  code: i64

type Count = i64

let speed: i64 = 3

fn speed-of() -> i64 = speed

struct Pair(a: i64, b: i64)

fn pair-sum(p: Pair) -> i64 = p.a + p.b

class shape(w, h)

generic area(s) -> dyn

method area(s: shape) = get(s, :w) * get(s, :h)

multi kind(v) -> dyn = type-of(v)

method kind(v) when :int = 1

method kind(v) when :else
  0

fn counted(n: Count) -> Count = n + 1

fn oops-code() -> i64
  handler-case
    error(Oops{.code 7})
  on Oops(c)
    c.code

macro dbl-of(x, & more)
  quote
    ~x + ~x

fn use-mac(k: i64) -> i64 = dbl-of(k)

fn gcd(a: i64, b: i64) -> i64
  let x = a
  let y = b
  while y != 0
    let r = x % y
    x = y
    y = r
  x

fn sum-to(n: i64) -> i64
  let i = 0
  let acc = 0
  until i > n
    acc += i
    i += 1
  acc

comment():
  if 1 < 2 and
     3 < 4
    twice(1)
  elif 1 > 2 or
       3 > 4
    0
  app(5, fn(a) =>
    a * 3
  )
  if 2 < 1 then 5
  elif 2 == 1 then 6
  else 7
  twice(4)
  if 2 > 1
    twice(2)
  else
    0
  let x = 3
  twice(x) + 1

fn grp(k: i64) -> i64
  let a = k + 1
      b = a * 2
  a + b

comment():
  let u = 2
      v = u * 5
  u + v
")

(defun test-flan-fln-live--run (backend args)
  (let* ((sock (concat test-flan-fln-live-socket "-fln-" backend))
         (file (expand-file-name (format "fln-live-%s.fln" backend)
                                 test-flan-fln-live-dir))
         (flan-daemon-args args)
         (name (lambda (s) (format "%s: %s" backend s)))
         (value (lambda (code)
                  (plist-get (flan--request
                              (list :op "eval-expr" :code code :file "<test>"))
                             :value)))
         (goto (lambda (needle &optional after)
                 (goto-char (point-min))
                 (search-forward needle)
                 (unless after (goto-char (match-beginning 0)))))
         (shows (lambda (v)
                  (let ((r (test-flan--result)))
                    (prog1 (and r (string-match-p (concat "=> " (regexp-quote v) "\\'")
                                                  (string-trim r)))
                      (flan-clear-result))))))
    (with-temp-file file (insert test-flan-fln-live--program))
    (ignore-errors (delete-file sock))
    (flan file sock)
    (test-flan--check (funcall name "a daemon starts on a .fln file")
                      (process-live-p flan--connection))
    (unwind-protect
    (with-current-buffer (find-file-noselect file)
      (test-flan--check (funcall name "which opens in flan-fln-mode")
                        (eq major-mode 'flan-fln-mode))

      ;; C-c C-c, from inside a fn changed in the buffer.
      (funcall goto "n * 2")
      (delete-char 5)
      (insert "n * 3")
      (flan-fln-eval-defun)
      (test-flan--check (funcall name "C-c C-c installs the fn at point")
                        (equal (funcall value "(twice 7)") "21"))

      ;; C-x C-e at the end of a column-0 declaration.
      (funcall goto "n * 3")
      (delete-char 5)
      (insert "n * 4")
      (flan-fln-eval-last)
      (test-flan--check (funcall name "C-x C-e at the end of a column-0 fn installs it")
                        (equal (funcall value "(twice 7)") "28"))

      ;; C-x C-e at the end of an inner statement: text from column 3.
      (funcall goto "twice(4)" t)
      (flan-fln-eval-last)
      (test-flan--check (funcall name "C-x C-e sends the statement ending at point")
                        (funcall shows "16"))

      ;; ...and inside a line, the term before point.
      (funcall goto "twice(4)")
      (let ((at (point)))
        (insert "fib(10) + ")
        (goto-char (+ at (length "fib(10)")))
        (flan-fln-eval-last)
        (test-flan--check (funcall name "C-x C-e inside a line sends the term before point")
                          (funcall shows "55"))
        (delete-region at (+ at (length "fib(10) + "))))

      ;; C-c C-e on a clause: the whole if, from column 3, clauses and all.
      (funcall goto "else\n    0")
      (flan-fln-eval-statement)
      (test-flan--check (funcall name "C-c C-e on a clause sends its if, and it reads")
                        (funcall shows "8"))

      ;; A bare let: it and the rest of its block, which is its scope.
      (funcall goto "let x = 3")
      (flan-fln-eval-statement)
      (test-flan--check (funcall name "C-c C-e on a bare let sends its scope with it")
                        (funcall shows "13"))

      ;; A let's bindings on the lines under it go with it, and read.
      (funcall goto "v = u * 5")
      (flan-fln-eval-statement)
      (test-flan--check (funcall name "C-c C-e on a binding line sends its let's group and scope")
                        (funcall shows "12"))

      ;; A region of several statements reads as one (do ...).
      (funcall goto "twice(4)")
      (transient-mark-mode 1)
      (set-mark (point))
      (funcall goto "else\n    0" t)
      (flan-fln-eval-statement)
      (test-flan--check (funcall name "C-c C-e on a region of statements evaluates them in order")
                        (funcall shows "8"))

      ;; C-c C-n sends and moves on.
      (funcall goto "twice(4)")
      (flan-fln-eval-statement-and-next)
      (test-flan--check (funcall name "C-c C-n sends the statement")
                        (funcall shows "16"))
      (test-flan--check (funcall name "and moves to the next")
                        (looking-at "if 2 > 1"))

      ;; A one-line if with its clauses on the lines under it.
      (funcall goto "if 2 < 1 then 5" t)
      (flan-fln-eval-last)
      (test-flan--check (funcall name "C-x C-e at the end of a one-line if that goes on evaluates the whole if")
                        (funcall shows "7"))
      (funcall goto "elif 2 == 1")
      (flan-fln-eval-statement)
      (test-flan--check (funcall name "C-c C-e on a clause under a one-line if sends its if")
                        (funcall shows "7"))
      ;; The newer forms install from the buffer and run.
      (pcase-dolist (`(,needle ,call ,want)
                     '(("fn sign2" "(sign2 0)" "0")
                       ("fn size" "(size 20)" "2")
                       ("fn lam" "(lam 3)" "7")
                       ("fn lam2" "(lam2 3)" "8")
                       ("fn rs" "(rs)" "3")
                       ("fn dir" "(dir :north)" "7")
                       ("struct Oops" "(oops-code)" "7")
                       ("type Count" "(counted 1)" "2")
                       ("struct Pair" "(pair-sum (Pair {.a 1 .b 2}))" "3")
                       ("fn pair-sum" "(pair-sum (Pair {.a 1 .b 2}))" "3")
                       ("class shape" "(i64 (area (shape 2 3)))" "6")
                       ("generic area" "(i64 (area (shape 2 3)))" "6")
                       ("method area" "(i64 (area (shape 2 3)))" "6")
                       ("multi kind" "(i64 (kind 3))" "1")
                       ("method kind(v) when :else" "(i64 (kind :x))" "0")
                       ("fn counted" "(counted 1)" "2")
                       ("fn oops-code" "(oops-code)" "7")
                       ("macro dbl-of" "(use-mac 5)" "10")
                       ("fn use-mac" "(use-mac 5)" "10")
                       ("fn gcd" "(gcd 1071 462)" "21")
                       ("fn sum-to" "(sum-to 4)" "10")))
        (funcall goto needle)
        (flan-fln-eval-defun)
        (test-flan--check (funcall name (format "C-c C-c installs %s" needle))
                          (equal (funcall value call) want)))

      ;; A top-level let is a global, installed and re-run by C-c C-c.
      (funcall goto "let speed: i64 = 3")
      (end-of-line)
      (delete-char -1)
      (insert "9")
      (flan-fln-eval-defun)
      (test-flan--check (funcall name "C-c C-c on a top-level let installs the global")
                        (equal (funcall value "(speed-of)") "9"))

      ;; A macro changed in the buffer and installed again reaches the
      ;; function installed after it.
      (funcall goto "~x + ~x")
      (delete-char 7)
      (insert "~x * 3")
      (funcall goto "macro dbl-of")
      (flan-fln-eval-defun)
      (funcall goto "fn use-mac")
      (flan-fln-eval-defun)
      (test-flan--check (funcall name "C-c C-c on a changed macro takes effect")
                        (equal (funcall value "(use-mac 5)") "15"))

      ;; The pause mark.  What is sent is a line and column, and the daemon
      ;; answers `:pause' only when a form the reader made starts exactly
      ;; there (`Ast.mark_pause').  Each kind of target once, and one position
      ;; a column off to show the answer can be no.
      ;; C-x C-e on an arm's value, and on a condition line.
      (funcall goto ":south -> 20" t)
      (flan-fln-eval-last)
      (test-flan--check (funcall name "C-x C-e at the end of a match arm evaluates its value")
                        (funcall shows "20"))
      (funcall goto ":east -> 1 +" t)
      (flan-fln-eval-last)
      (test-flan--check (funcall name "C-x C-e on an arm's wrapped value evaluates all of it")
                        (funcall shows "3"))
      (funcall goto "if 1 < 2 and" t)
      (flan-fln-eval-last)
      (test-flan--check (funcall name "C-x C-e on a wrapped condition evaluates all of it")
                        (funcall shows "true"))
      ;; An error on the wrapped line of a condition or value cut out
      ;; mid-line is reported where it is in the buffer, column and all.
      (let ((refused
             (lambda (needle bad fix)
               (funcall goto needle t)
               (let ((line (1+ (line-number-at-pos))) col)
                 (save-excursion
                   (forward-line 1)
                   (search-forward fix (line-end-position))
                   (replace-match bad t t)
                   (setq col (1+ (- (point) (line-beginning-position)
                                    (length (car (last (split-string bad " "))))))))
                 (prog1 (list (condition-case err (progn (flan-fln-eval-last) nil)
                                (user-error (error-message-string err)))
                              (format ":%d:%d)" line col))
                   (save-excursion
                     (goto-char (point-min))
                     (search-forward bad)
                     (replace-match fix t t)))))))
        (pcase-dolist (`(,what ,needle ,bad ,fix)
                       '(("an if condition" "if 1 < 2 and" "3 < 4 4" "3 < 4")
                         ("an elif condition" "elif 1 > 2 or" "3 > 4 4" "3 > 4")
                         ("an arm's value" ":east -> 1 +" "2 2" "2")))
          (let ((r (funcall refused needle bad fix)))
            (test-flan--check
             (funcall name (format "an error on the wrapped line of %s is reported at its column" what))
             (and (car r) (string-suffix-p (cadr r) (car r))))
            (unless (and (car r) (string-suffix-p (cadr r) (car r)))
              (message "       want ...%s\n       got  %S" (cadr r) (car r))))))
      (flan-clear-errors)
      ;; A lambda's block inside a call's brackets: the call goes whole
      ;; from its header line, and reads.
      (funcall goto "app(5")
      (flan-fln-eval-statement)
      (test-flan--check (funcall name "C-c C-e on a call with a block lambda sends it whole, and it reads")
                        (funcall shows "15"))
      (funcall goto "app(5, fn(a) =>" t)
      (flan-fln-eval-last)
      (test-flan--check (funcall name "C-x C-e at the end of its header line too")
                        (funcall shows "15"))
      (funcall goto "if 2 > 1" t)
      (flan-fln-eval-last)
      (test-flan--check (funcall name "C-x C-e at the end of an if line evaluates the condition")
                        (funcall shows "true"))
      (dolist (c '(("n - 1)" "a call, from its name")
                   ("elif n" "an elif, at its condition")
                   ("else\n    1" "an else, at its block")
                   (":south -> 20" "a match arm, at its value")
                   ("_ ->" "a match arm, at its block")
                   ("n < 2" "an if statement")
                   ("t = 0" "a let")
                   ("i in range" "a for")
                   ("+ i" "an assignment")
                   ("if k < 0 then" "a one-line if")
                   ("elif k" "a one-line elif, at its condition")
                   ("else 1" "a one-line else, at its value")
                   ("else 2" "a one-line else after a block, at its value")
                   ("a: i64, b" "a typed lambda, from its fn")
                   ("a * 2" "a typed lambda's block")
                   ("x) =>" "a block lambda in a call, from its fn")
                   ("let y = x" "a statement in a block lambda's block")
                   ("y)" "the block's last statement, less the call's closer")
                   ("let b = app" "a merged let's call with a block lambda, at its value")
                   ("let c = fn" "a merged let's block lambda, at its value")
                   ("restart retry" "a restart with a report, at its block")
                   ("Dir.north" "an enum member's arm, at its value")
                   ("let b = 2" "a let the let above takes in, at its value")
                   ("let c: i64" "a typed one, at its value")
                   ("while y != 0" "a while, at its word")
                   ("let r = x % y" "a while's block")
                   ("until i > n" "an until, at its word")
                   ("acc += i" "an until's block")
                   ("b = a * 2" "a binding under a let, at its value")))
        (funcall goto (car c))
        (let ((reply (flan-fln-eval-defun '(4))))
          (test-flan--check (funcall name (format "C-u C-c C-c marks %s where the reader starts it"
                                                  (cadr c)))
                            (plist-get reply :pause)))
        (flan-fln-eval-defun))
      (test-flan--check (funcall name "and a plain C-c C-c takes the mark down")
                        (null (flan--pause-overlays)))
      (funcall goto "fib(n - 1)")
      (let* ((b (flan-fln--toplevel-bounds (point)))
             (off (condition-case nil
                      (plist-get (flan--eval (flan--text (car b) (cdr b)) "defn"
                                             nil nil (cons (1+ (point)) (+ 3 (point))))
                                 :pause)
                    (user-error nil))))
        (test-flan--check (funcall name "a position one column off the call is not taken")
                          (null off)))
      (flan-fln-eval-defun)
      (set-buffer-modified-p nil)
      (kill-buffer))
    ;; Stopped whatever happened above: a daemon this started is its own to end.
    (flan-quit))
    (ignore-errors (delete-file sock))
    (ignore-errors (delete-file file))))

(message "\nthe .fln keys, against a daemon on each backend")
(test-flan-fln-live--run "x86" nil)
(test-flan-fln-live--run "llvm" '("--llvm"))

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