;;; org-elib-async.el --- Helper to write asynchronous functions -*- lexical-binding: t -*-

;; Copyright (C) 2024 Bruno BARBIER

;; Author: Bruno BARBIER
;; Version: 0.0.0
;; Maintainer: Bruno BARBIER
;; Keywords:
;; Status: WORK IN PROGRESS.  DO NOT USE.
;; URL:
;; Compatibility: GNU Emacs 30.0.50
;;
;; This file is NOT (yet) 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 2 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, write to the Free
;; Software Foundation, Inc., 59 Temple Place, Suite 330, Boston,
;; MA 02111-1307 USA


;;; Commentary:
;; Names with "--" are for functions and variables that are meant to be for
;; internal use only.

;;;; Description
;; Some functions to help dealing with asynchronous tasks.

;; The prefix 'org-elib' means that this package should evenutally be
;; moved into core Emacs.  The functions defined here do NOT depend
;; nor rely on org itself.

;;; TODOs
;;
;; - Keywords
;;


;;; Code:
;;
(require 'cl-lib)
(require 'org-id)

;;;; Process
;;
(cl-defun org-elib-async-process (command &key input callback)
  "Execute COMMAND.

A quick naive featureless boggus wrapper around `make-process' to
receive the result when the process is done.

When INPUT is non-nil, use it as the COMMAND standard input.  Let DATA
be the COMMAND output, if COMMAND succeeds, call CALLBACK with
(:success DATA), else, call CALLBACK with (:failure DATA)."
  (let* ((stdout-buffer (generate-new-buffer "*org-elib-async-process*"))
         (get-outcome
          (lambda (process)
            (with-current-buffer stdout-buffer
              (let* ((exit-code (process-exit-status process))
                     (real-end ;; Getting rid of the user message.
                      (progn (goto-char (point-max))
                             (forward-line -1)
                             (point)))
                     (txt (string-trim (buffer-substring-no-properties
                                        (point-min) real-end))))
                (list (if (eq 0 exit-code) :success :failure)
                      (if (not (string-empty-p txt)) txt
                        (and (not (eq 0 exit-code)) exit-code)))))))
         (process (make-process
                   :name "*org-elib-async-process*"
                   :buffer  stdout-buffer
                   :command command
                   :connection-type 'pipe))
         (sentinel
          (lambda (&rest _whatever)
            (pcase (process-status process)
              ('run )
              ('stop)
              ((or 'exit 'signal)
               (funcall callback (funcall get-outcome process)))
              (_ (error "Not a real process"))))))
    (add-function :after (process-sentinel process) sentinel)
    (when input
      (process-send-string process input)
      (process-send-eof process))
    process))
;; (org-elib-async-process (list "date") :callback (lambda (o) (message "outcome: %S" o)))
;; (org-elib-async-process (list "false") :callback (lambda (o) (message "outcome: %S" o)))
;; (org-elib-async-process (list "true") :callback (lambda (o) (message "outcome: %S" o)))
;; (org-elib-async-process (list "bash" "-c" "bash") :input "date" :callback (lambda (o) (message "outcome: %S" o)))
;; (org-elib-async-process (list "bash") :input "date" :callback (lambda (o) (message "outcome: %S" o)))
;; (org-elib-async-process (list "bash") :input "false" :callback (lambda (o) (message "outcome: %S" o)))
;; (org-elib-async-process (list "bash") :input "true" :callback (lambda (o) (message "outcome: %S" o)))
;; (org-elib-async-process (list "bash") :input "sleep 2; date" :callback (lambda (o) (message "outcome: %S" o)))


;;;; Wait for a process until some condition becomes true.

(define-error 'org-elib-async-timeout-error
              "Timeout waiting for a process.")

(cl-defun org-elib-async-wait-condition ( cond-p
                                          &key
                                          (tick .3) (message "Waiting")
                                          (nb_secs_between_messages 5)
                                          timeout)
  "Wait until the condition COND-P returns non-nil.
Repeatedly call COND-P with no arguments, about every TICK seconds,
until it returns a non-nil value.  Return that non-nil value.  When
TIMEOUT (seconds) is non-nil, raise an `org-elib-async-timeout-error' if
the COND-P is still nil after TIMEOUT seconds.  Assume COND-P calls cost
0s.  Do NOT block display updates.  Do not block process outputs.  Do
not block idle timers.  Do block the user, letting him/her know why, but
do not display more messages than one every NB_SECS_BETWEEN_MESSAGES.
Default MESSAGE is \"Waiting\".  Use 0.3s as the default for TICK."
  ;; FIXME: Still not sure if it's possible to write such a function.
  (let ((keep-waiting t)
        (result nil)
        (start (float-time))
        elapsed
        last-elapsed)
    (while keep-waiting
      (setq result (funcall cond-p))
      (if result
          (setq keep-waiting nil)
        (sleep-for 0.01)
        (redisplay :force)
        (setq elapsed (- (float-time) start))
        (when (and timeout (> elapsed timeout))
          (signal 'org-timeout-error (list message elapsed)))
        ;; Let the user know, without flooding the message area.
        (if (and last-elapsed (> (- elapsed last-elapsed) nb_secs_between_messages))
            (message (format "%s ...(%.1fs)" message elapsed)))
        (unless (sit-for tick :redisplay)
          ;; Emacs has something to do; let it process new
          ;; sub-processes outputs in case there are some.
          (accept-process-output nil 0.01))
        (setq last-elapsed elapsed)))
    result))



;;;; Comint: a FIFO queue of tasks with callbacks
;; org-elib-async-comint-queue executes tasks in a FIFO order. For each
;; task, it identifies the text output for that
;; task. org-elib-async-comint-queue does NOT remove prompts, or other
;; useless texts; this is the responsibility of the user.  Currently,
;; org-elib-async-comint-queue assume it has the full control of the
;; session: no user interaction, no other direct modifications.

(defvar-local org-elib-async-comint-queue--todo :NOT-SET
  "A FIFO queue of pending executions.")


(defvar-local org-elib-async-comint-queue--unused-output ""
  "Process output that has not been used yet.")

(defvar-local org-elib-async-comint-queue--incoming-text ""
  "Newly incoming text, added by the process filter, not yet handled.")

(defvar-local org-elib-async-comint-queue--current-task nil
  "The task that is currently running.")

(defvar-local org-elib-async-comint-queue--process-filter-running nil
  "non-nil when filter is running.")

(defvar-local org-elib-async-comint-queue--incoming-timer nil
  "A timer, when handling incoming text is scheduled or running.")


(defvar-local org-elib-async-comint-queue--handle-incoming-running
    nil
  "True when the incoming text handler is running.")

(defun org-elib-async-comint-queue--handle-incoming ()
  (when org-elib-async-comint-queue--handle-incoming-running
    (error "Bad call to handle-incoming: kill buffer %s!" (current-buffer)))
  (setq org-elib-async-comint-queue--handle-incoming-running t)

  ;; Take the incoming text.
  (setq org-elib-async-comint-queue--unused-output
        (concat org-elib-async-comint-queue--unused-output
                org-elib-async-comint-queue--incoming-text))
  (setq org-elib-async-comint-queue--incoming-text "")

  ;; Process the unused text with the queued tasks
  (unless org-elib-async-comint-queue--current-task
    (when org-elib-async-comint-queue--todo
      (setq org-elib-async-comint-queue--current-task (pop org-elib-async-comint-queue--todo))))
  (when-let ((task org-elib-async-comint-queue--current-task))
    (let ((unused org-elib-async-comint-queue--unused-output)
          (session-buffer (current-buffer))
          task-start)
      (setq org-elib-async-comint-queue--unused-output
            (with-temp-buffer
              (insert unused)
              (goto-char (point-min))
              (while (and task
                          (setq task-start (point))
                          (search-forward (car task) nil t))
                (when (cdr task)
                  (let ((txt (buffer-substring-no-properties task-start
                                                             (- (point) (length (car task))))))
                    (save-excursion (funcall (cdr task) txt))))
                (setq task (and (buffer-live-p session-buffer)
                                (with-current-buffer session-buffer (pop org-elib-async-comint-queue--todo)))))
              (buffer-substring (point) (point-max))))
      (setq org-elib-async-comint-queue--current-task task)))

  ;; Signal that we are done. If we already have some new incoming text,
  ;; reschedule to run.
  (setq org-elib-async-comint-queue--incoming-timer
        (if (string-empty-p org-elib-async-comint-queue--incoming-text)
            nil
          (org-elib-async-comint-queue--wake-up-handle-incoming)))

  ;; We reset it only on success. If it failed for some reason, the
  ;; comint buffer is in an unknown state: you'll need to kill that
  ;; buffer.
  (setq org-elib-async-comint-queue--handle-incoming-running nil))


(defun org-elib-async-comint-queue--wake-up-handle-incoming ()
  "Wake up the handling of incoming chunks of text.
Assume we are called from the comint buffer."
  (setq org-elib-async-comint-queue--incoming-timer
        (run-with-timer
         0.01 nil
         (let ((comint-buffer (current-buffer)))
           (lambda ()
             (with-local-quit
               (with-current-buffer comint-buffer
                 (org-elib-async-comint-queue--handle-incoming))))))))


(defun org-elib-async-comint-queue--process-filter (chunk)
  "Accept the arbitrary CHUNK of text."
  (setq org-elib-async-comint-queue--incoming-text
        (concat org-elib-async-comint-queue--incoming-text
                chunk))
  :; We delegate the real work outside the process filter, as it is
   ; not reliable to do anything here.
  (unless org-elib-async-comint-queue--incoming-timer
    (org-elib-async-comint-queue--wake-up-handle-incoming)))



(define-error 'org-elib-async-comint-queue-task-error
              "Task failure.")

(cl-defun org-elib-async-comint-queue--push (exec &key handle-feedback)
  "Push the execution of EXEC into the FIFO queue.
When the task completed, call HANDLE-FEEDBACK with its outcome.  Return
a function that waits for and return the result on succes, raise on
failure."
  (let* ((tid (org-id-uuid))
         (start-tag (format "ORG-ELIB-ASYNC_START_%s" tid))
         (end-tag (format "ORG-ELIB-ASYNC_END___%s" tid))
         (result-sb (make-symbol "result"))
         (on-start
          (lambda (_)
            ;; TODO: Use (point) in session to link back to it.
            (when handle-feedback
              (funcall handle-feedback '(:pending "running")))))
         (on-result
          (lambda (result)
            ;; Get the result, and report success using HANDLE-FEEDBACK.
            ;; If something fails, report failure using HANDLE-FEEDBACK.
            (unwind-protect
                (let ((outcome
                       (condition-case-unless-debug exc
                           (list :success (funcall exec :post-process result))
                         (error (list :failure exc)))))
                  (when handle-feedback (save-excursion (funcall handle-feedback outcome)))
                  (set result-sb outcome))
              (funcall exec :finally)))))

    ;; TODO: Add detect-properties => alist of properties that can be used: PS1 and PS2
    (let ((comint-buffer (funcall exec :get-comint-buffer)))
      (with-current-buffer comint-buffer
        (setq org-elib-async-comint-queue--todo
              (nconc org-elib-async-comint-queue--todo
                     (list (cons start-tag on-start)
                           (cons end-tag on-result))))
        (funcall exec :send-instrs-to-session
                 (funcall exec :instrs-to-enter))
        (funcall exec :send-instrs-to-session
                 (funcall exec :instr-to-emit-tag start-tag))
        (funcall exec :send-instrs-to-session
                 (funcall exec :get-code))
        (funcall exec :send-instrs-to-session
                 (funcall exec :instr-to-emit-tag end-tag))
        (funcall exec :send-instrs-to-session
                 (funcall exec :instrs-to-exit))

        (lambda ()
          (org-elib-async-wait-condition (lambda ()
                                           (boundp result-sb)))
          (pcase (symbol-value result-sb)
            (`(:success ,r) r)
            (`(:failure ,err) (signal (car err) (cdr err)))))
        ))))



(defun org-elib-async-comint-queue-init-if-needed (buffer)
  "Initialize the FIFO queue in BUFFER if needed."
  (with-current-buffer buffer
    (unless (local-variable-p 'org-elib-async-comint-queue--todo)
      (setq-local org-elib-async-comint-queue--todo nil)
      (add-hook 'comint-output-filter-functions
                #'org-elib-async-comint-queue--process-filter nil :local))))



;;;; Provide
(provide 'org-elib-async)
;;; org-elib-async.el ends here