;;; erc-d-u.el --- Helpers for ERC test server -*- lexical-binding: t -*-

;; Copyright (C) 2020-2021 Free Software Foundation, Inc.
;;
;; This file is part of GNU Emacs.
;;
;; This program 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.
;;
;; This program 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 this program.  If not, see
;; <https://www.gnu.org/licenses/>.

;;; Commentary:

;; The utilities here are kept separate from those in `erc-d' so that
;; tests running the server in a subprocess can use them without
;; having to require the main lib.  If migrating outside of test/lisp,
;; there may be no reason to continue this.
;;
;; Another (perhaps misguided) goal here is to avoid having ERC itself
;; as a dependency.
;;
;; FIXME this ^ is no longer the case (ERC is not a dependency)

;;; Code:
(require 'rx)
(require 'generator)
(require 'subr-x)
(eval-when-compile (require 'ert))

(defvar erc-d-u--canned-buffers nil
  "List of canned dialog buffers currently open for reading.")

(defun erc-d-u--canned-read (file)
  "Read canned FILE as generator and yield exchanges as iterators."
  (let* ((buf (generate-new-buffer (file-name-nondirectory file)))
         (coding-system-for-read 'utf-8)
         (parse-sexp-ignore-comments t)
         ;; Actually, "done" only means outer exchange genny is done.
         last done specs
         ;;
         (done-cb (lambda ()
                    (kill-buffer buf)
                    (setq erc-d-u--canned-buffers
                          (delq buf erc-d-u--canned-buffers))))
         (fspec (iter-lambda (pos)
                  (let (val)
                    (while (and specs
                                (with-current-buffer buf
                                  (goto-char pos)
                                  (condition-case _err
                                      (setq val (read pos))
                                    ;; Raised unless malformed
                                    (invalid-read-syntax nil))))
                      (iter-yield val)))
                  (setq specs (delq pos specs))
                  (unless (or specs (not done))
                    (funcall done-cb)
                    (setq done-cb #'ignore)))))
    (push buf erc-d-u--canned-buffers)
    (with-current-buffer buf
      (insert-file-contents-literally file)
      (lisp-data-mode))
    (iter-lambda ()
      ;; Yielding isn't allowed inside save-excursion, etc.
      (while (with-current-buffer buf
               (condition-case _err
                   (progn
                     (when last
                       (goto-char last)
                       (forward-list))
                     (setq last (point))
                     (down-list)
                     (push (set-marker (make-marker) (point)) specs)
                     t)
                 ((end-of-buffer scan-error)
                  (setq done t)
                  nil)))
        ;; Suppose we *could* yield specs directly here but then
        ;; detecting exchange boundaries is more of a headache
        (iter-yield (funcall fspec (car specs))))
      (unless specs
        (funcall done-cb))
      nil)))

(defvar erc-d-u--library-directory (file-name-directory load-file-name))
(defvar erc-d-u-canned-dialog-dir
  (file-name-as-directory (expand-file-name "erc-d-self-resources"
                                            erc-d-u--library-directory)))

(defun erc-d-u--normalize-canned-name (dialog)
  "Return DIALOG name as a symbol without validating it."
  (if (symbolp dialog)
      dialog
    (intern (file-name-base dialog))))

(defvar erc-d-u-canned-file-name-extension "lispdata")

(defun erc-d-u--expand-dialog-symbol (dialog)
  "Return filename based on symbol DIALOG."
  (let ((name (symbol-name dialog)))
    (unless (equal (file-name-extension name)
                   erc-d-u-canned-file-name-extension)
      (setq name (concat name "." erc-d-u-canned-file-name-extension)))
    (expand-file-name name erc-d-u-canned-dialog-dir)))

(defun erc-d-u--massage-canned-name (dialog)
  "Return DIALOG in a form acceptable to `erc-d-run'."
  (if (or (symbolp dialog) (file-exists-p dialog))
      dialog
    (erc-d-u--expand-dialog-symbol (intern dialog))))

(defun erc-d-u--canned-load-dialog (dialog &optional start)
  "Load and maybe START dispensing exchanges from DIALOG.
If DIALOG is a string, consider it a file path.  Otherwise find a file
in `erc-d-u-canned-dialog-dir' with a base name matching the symbol's
name.

Return an iterator that yields exchanges, each one an iterator of spec
forms.  The first is a so-called request spec and the rest are composed
of zero or more response specs."
  (when (symbolp dialog)
    (setq dialog (erc-d-u--expand-dialog-symbol dialog)))
  (unless (file-exists-p dialog)
    (error "File not found: %s" dialog))
  (let ((genny (erc-d-u--canned-read dialog)))
    (if start (funcall genny) genny)))

(defun erc-d-u--rewrite-for-slow-mo (num ex-it)
  "Return modified iterator or generator from original EX-IT.
When NUM is a positive number, delay incoming requests by NUM more
seconds.  If NUM is negative, raise insufficient incoming delays to at
least -NUM seconds.  If NUM is a function, set each delay to whatever it
returns when called with the existing value."
  (let* ((genny-in (zerop (car (func-arity ex-it))))
         (g (iter-lambda ()
              (let ((ex-it (if genny-in (funcall ex-it) ex-it))
                    next)
                (while
                    (when (setq next (condition-case err
                                         (iter-next ex-it)
                                       (iter-end-of-sequence
                                        (setq ex-it nil)
                                        (cdr err))))
                      (iter-yield
                       (funcall
                        (iter-lambda ()
                          (iter-do (spec next)
                            (when (symbolp (car spec))
                              (let ((new (cond
                                          ((functionp num)
                                           (funcall num (nth 1 spec)))
                                          ((< num 0)
                                           (max (nth 1 spec) (- num)))
                                          (t (+ (nth 1 spec) num)))))
                                (setf (nth 1 spec) new)))
                            (iter-yield spec)))))
                      t))
                next))))
    (if genny-in g (funcall g))))

(defun erc-d-u--get-remote-port (process)
  "Return peer TCP port for client PROCESS.
When absent, just generate an id."
  (let ((remote (plist-get (process-contact process t) :remote)))
    (if (vectorp remote)
        (aref remote (1- (length remote)))
      (format "%s:%d" (process-contact process :local)
              (logand 1023 (time-convert nil 'integer))))))

(defun erc-d-u--format-bind-address (process)
  "Return string or (STRING . INT) for bind address of network PROCESS."
  (let ((local (process-contact process :local)))
    (if (vectorp local) ; inet
        (cons (mapconcat #'number-to-string (seq-subseq local 0 -1) ".")
              (aref local (1- (length local))))
      local)))

(defun erc-d-u--unkeyword (plist)
  "Return a copy of PLIST with keywords keys converted to non-keywords."
  (cl-loop for (key value) on plist by #'cddr
           when (keywordp key)
           do (setq key (intern (substring (symbol-name key) 1)))
           append (list key value)))

(defvar-local erc-d-u--process-buffer nil
  "Beacon for erc-d process buffers.
The server process is usually deleted first, but we may want to examine
the buffer afterward.")

(provide 'erc-d-u)
;;; erc-d-u.el ends here