;;; etaf-actions.el --- Named ETAF mutation actions -*- lexical-binding: t; -*-

;; SPDX-License-Identifier: GPL-3.0-or-later

;;; Commentary:

;; An Action is one named, testable business mutation entry.  It is not a
;; View node and does not own rendering; the current Runtime owns the event
;; boundary and reactive values own publication after an action mutates them.

;;; Code:

(require 'cl-lib)
(require 'etaf-runtime)

(defvar etaf--current-runtime)

(define-error 'etaf-action-error "Invalid ETAF Action")

(cl-defstruct (etaf-action-spec
               (:constructor etaf--action-spec-create))
  "Registered named Action."
  name
  function)

(defvar etaf--action-registry (make-hash-table :test #'eq)
  "Action name -> `etaf-action-spec' table.")

(defun etaf-action-register (name function)
  "Register FUNCTION as named Action NAME and return NAME."
  (unless (and (symbolp name) (not (keywordp name)) (functionp function))
    (signal 'etaf-action-error
            (list (format "Invalid Action registration: %S" name))))
  (puthash name (etaf--action-spec-create :name name :function function)
           etaf--action-registry)
  name)

(defmacro etaf-action-define (name arguments &rest body)
  "Define and register named Action NAME with ARGUMENTS and BODY.

The generated function receives RUNTIME as its first argument when called
through `etaf-dispatch'."
  (declare (indent 2) (debug defun))
  (unless (symbolp name)
    (signal 'etaf-action-error (list "Action name must be a symbol")))
  (let ((docstring (when (stringp (car body)) (pop body)))
        (function-symbol (intern (format "%s--etaf-action" name))))
    `(progn
       (defun ,function-symbol ,arguments
         ,(or docstring (format "Run ETAF Action `%s'." name))
         ,@body)
       (etaf-action-register ',name #',function-symbol)
       ',name)))

;;;###autoload
(defun etaf-dispatch (action &rest arguments)
  "Dispatch named ACTION through the active Runtime with ARGUMENTS.

An explicit Runtime may be supplied as the first argument: `(etaf-dispatch
RUNTIME ACTION ...)'.  Action functions receive Runtime first."
  (let* ((explicit-runtime (etaf-runtime-p action))
         (runtime (if explicit-runtime
                      action
                    (and (boundp 'etaf--current-runtime)
                         etaf--current-runtime)))
         (action (if explicit-runtime
                     (pop arguments)
                   action))
         (spec (gethash action etaf--action-registry)))
    (unless (symbolp action)
      (signal 'etaf-action-error
              (list "Action name must be a symbol")))
    (unless (and runtime (etaf-runtime-p runtime)
                 (etaf-runtime-mounted-p runtime))
      (signal 'etaf-runtime-error
              (list "ETAF runtime is not mounted")))
    (unless spec
      (signal 'etaf-action-error
              (list (format "Unknown ETAF Action: %S" action))))
    (let ((etaf--current-runtime runtime))
      (apply (etaf-action-spec-function spec) runtime arguments))))

;;;###autoload
(defun etaf-action-undefine (name)
  "Remove named Action NAME and return NAME."
  (remhash name etaf--action-registry)
  name)

(provide 'etaf-actions)

;;; etaf-actions.el ends here