;;; erc-fill-tests.el --- ERC message filling -*- lexical-binding: t -*-

;; Copyright (C) 2020-2021 Free Software Foundation, Inc.

;; This file is part of GNU Emacs.
;;
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published
;; by the Free Software Foundation, either version 3 of the License,
;; or (at your option) any later version.
;;
;; GNU Emacs is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;; General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.

;;; Code:

(require 'ert-x)
(require 'erc-fill)

(defun erc-fill-tests--insert (&rest strings)
  (let ((inhibit-read-only t))
    (erc-parse-server-response erc-server-process (apply #'concat strings))))

(defun erc-fill-tests--setup-server-buffer ()
  (with-current-buffer (get-buffer-create "foonet")
    (erc-mode)
    (setq erc-server-process (start-process "true" (current-buffer) "true")
          erc-server-current-nick "tester"
          erc-server-users (make-hash-table :test #'equal))
    (set-process-query-on-exit-flag erc-server-process nil)))

(defun erc-fill-tests--setup-channel-buffer ()
  (with-current-buffer (get-buffer-create "#chan")
    (erc-mode)
    (insert "\n\n")
    (setq erc-input-marker (make-marker)
          ;; Kludge to get around saving display prop
          erc-timestamp-use-align-to nil
          ;; Kludge to make whitespace compare equal without expanding
          indent-tabs-mode nil
          erc-insert-marker (make-marker)
          erc-default-recipients '("#chan")
          erc-channel-users (make-hash-table :test #'equal)
          erc-server-process (with-current-buffer "foonet"
                               erc-server-process))
    (set-marker erc-insert-marker (point-max))
    (erc-display-prompt)))

(defun erc-fill-tests--setup ()
  (advice-add 'format-time-string :filter-args
              (lambda (args) (list (car args) (cadr args) 0)) '((name . ts)))

  (erc-stamp-mode +1)

  (erc-fill-tests--setup-server-buffer)
  (erc-fill-tests--setup-channel-buffer)
  (erc-fill-tests--populate))

(defun erc-fill-tests--populate ()
  (let* ((ts (+ (* 2 60 60 24) (* 60 60 24 365 10))) ; Jan 1 1980
         (ct (time-convert ts)))

    (cl-letf (((symbol-function 'current-time) (lambda () ct)))
      (with-current-buffer "foonet"
        (erc-fill-tests--insert ":irc.foonet.org 353 tester = #chan :"
                                "alice @bob robot tester")
        (erc-fill-tests--insert ":irc.foonet.org 366 tester #chan :"
                                "End of /NAMES list.")
        (erc-fill-tests--insert ":irc.foonet.org 324 tester #chan +nt")
        (erc-fill-tests--insert ":irc.foonet.org 329 tester #chan 1620104779")

        (setq ct (time-convert (cl-incf ts 60)))
        (erc-fill-tests--insert
         ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #chan :lorem ipsum"
         " This buffer is for text that is not saved, and for Lisp evaluation.")

        (setq ct (time-convert (cl-incf ts 120)))
        (erc-fill-tests--insert
         ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #chan :tester, welcome!"
         " Your name may or may not be highlighted depending on whether"
         " erc-button's been enabled by an earlier test. ERC needs help!")

        (erc-fill-tests--insert
         ":robot!~u@rz2v467q4rwhy.irc PRIVMSG #chan :・゜゜・。。・゜゜\\_o< QUACK!")

        (setq ct (time-convert (cl-incf ts (* 60 60 24))))
        (erc-fill-tests--insert
         ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #chan :tester, welcome!"
         " To create a file, visit it with ? and enter text in its buffer.")))))

(defun erc-fill-tests--teardown ()
  (advice-remove 'format-time-string 'ts)
  (let (erc-kill-server-hook
        erc-kill-channel-hook)
    (kill-buffer "#chan")
    (kill-buffer "foonet"))
  (should (= erc-fill-column 78)))

(defun erc-fill-tests--compare (name)
  ;; Git didn't allow committing with a trailing space after the
  ;; prompt, hence this:
  (equal (substring-no-properties (buffer-string) 0 -1)
         (with-temp-buffer
           (insert-file-contents (ert-resource-file name))
           (buffer-string))))

(defun erc-fill-tests--await-fill ()
  (call-interactively #'erc-fill-buffer)
  ;; This timeout silliness seemed a little more realistic than just:
  ;;
  ;;   (thread-join erc-fill--refill-thread)
  ;;
  ;; Probably dumb, right?.
  (with-timeout (3 (error "Failed"))
    (while (thread-live-p erc-fill--refill-thread)
      (sleep-for 0.01))))

(ert-deftest erc-fill-buffer ()
  (let* (erc-insert-pre-hook
         erc-insert-modify-hook
         erc-send-modify-hook
         erc-mode-hook
         erc-stamp-mode
         erc-fill--refill-thread)

    (erc-fill-tests--setup)

    (with-current-buffer "#chan"
      ;; These would get clobbered by the new thread if we let-bound
      ;; them, and we can't set them globally, so best just fake it:
      (setq-local erc-fill-mode t
                  erc-stamp-mode t
                  erc-fill-column 60)
      (erc-fill-tests--await-fill)
      (ert-info ("Baseline")
        (should (erc-fill-tests--compare "variable-60.buffer")))

      (ert-info ("Wider")
        (setq erc-fill-column 72)
        (erc-fill-tests--await-fill)
        (should (erc-fill-tests--compare "variable-72.buffer")))

      (ert-info ("Fancy")
        (setq erc-fill-function #'erc-fill-static)
        (erc-fill-tests--await-fill)
        (should (erc-fill-tests--compare "static-72.buffer")))

      (ert-info ("Fancy normal")
        (setq erc-fill-column 60)
        (erc-fill-tests--await-fill)
        (should (erc-fill-tests--compare "static-60.buffer")))

      (ert-info ("Again!")
        (erc-fill-tests--await-fill)
        (should (erc-fill-tests--compare "static-60.buffer")))

      (ert-info ("Back home")
        (setq erc-fill-function #'erc-fill-variable)
        (erc-fill-tests--await-fill)
        (should (erc-fill-tests--compare "variable-60.buffer")))))

  (when noninteractive
    (erc-fill-tests--teardown)))

(ert-deftest erc-fill-buffer--interrupted ()
  (let* (erc-insert-pre-hook
         erc-insert-modify-hook
         erc-send-modify-hook
         erc-mode-hook
         erc-stamp-mode
         erc-fill--refill-thread)

    (erc-fill-tests--setup)

    (with-current-buffer "#chan"
      (setq-local erc-fill-mode t ; see note re these in prev test
                  erc-stamp-mode t
                  erc-fill-column 60)
      (erc-fill-tests--await-fill)
      (ert-info ("Baseline")
        (should (erc-fill-tests--compare "variable-60.buffer")))

      (ert-info ("Denied")
        (setq erc-fill-column 72)
        (call-interactively #'erc-fill-buffer)
        (should-error (erc-fill-buffer nil))
        (thread-join erc-fill--refill-thread)
        (should (erc-fill-tests--compare "variable-72.buffer")))

      (ert-info ("Canceled")
        (setq erc-fill-column 60)
        (call-interactively #'erc-fill-buffer)
        (sleep-for (cl-random 0.1))
        (erc-fill-buffer t)
        (thread-join erc-fill--refill-thread)
        (should (erc-fill-tests--compare "variable-60.buffer")))))

  (when noninteractive
    (erc-fill-tests--teardown)))

;;; erc-fill-tests.el ends here