etaf-playground/etaf-playground.el

;;; etaf-playground.el --- ETAF operations-console application pair -*- lexical-binding: t; -*-
;;; Commentary:
;; One reviewed pair: inert `.etaf' data plus an executable companion.
;;; Code:
(require 'cl-lib)
(require 'etaf)
(require 'etaf-ui)

(defconst etaf-playground-buffer-name "*ETAF Playground*")
(defconst etaf-playground-example-directory
  (expand-file-name "examples"
                    (file-name-directory (or load-file-name buffer-file-name))))
(defconst etaf-playground-scenario-manifest
  '((:pair "operations-console" :root-component etaf-operations-console-root
     :category "Complete application"
     :capabilities (view component reactivity context theme behavior events
                    actions data resource lifecycle etaf-ui)
     :refs (operations-console-alpha-increment operations-console-alpha-reset
            operations-console-beta-increment operations-console-beta-reset
            operations-console-nav-overview operations-console-nav-data
            operations-console-nav-resource operations-console-theme-toggle
            operations-console-local-callback operations-console-named-action
            operations-console-behavior-toggle operations-console-clear-selection
            operations-console-row-1 operations-console-row-2 operations-console-row-3
            operations-console-fail-next
            operations-console-resource-reload operations-console-error-boundary)
     :gui-checkpoints (compact fullscreen overview data resource theme focus)
     :performance (:warm-runs 10 :publication-per-event 1)))
  "The sole active Playground pair and its public review metadata.")
(defconst etaf-playground-example-names '("operations-console"))
(defvar-local etaf-playground-current-example nil)
(defconst etaf-playground--static-tags
  '(operations-console-shell header brand summary theme-control navigation tab
    main overview hero metric-strip metric workspace activity-panel
    capability-panel timeline data resource status
    column row text spacer panel label viewport-height stretch))

(defun etaf-playground-scenario (name)
  "Return the sole manifest entry named NAME."
  (or (and (equal name "operations-console")
           (car etaf-playground-scenario-manifest))
      (user-error "Unknown ETAF Playground pair: %s" name)))

(defun etaf-playground--pair-file (name suffix)
  "Return NAME pair path ending in SUFFIX."
  (expand-file-name (concat name suffix) etaf-playground-example-directory))

(defun etaf-playground--validate-static-node (node)
  "Validate inert static View NODE and return it."
  (cond
   ((or (null node) (stringp node) (numberp node) (keywordp node)
        (memq node '(t stretch viewport-height))) node)
   ((consp node)
    (unless (and (proper-list-p node) (symbolp (car node))
                 (memq (car node) etaf-playground--static-tags)
                 (not (string-prefix-p "etaf--" (symbol-name (car node))))
                 (not (string-prefix-p "ebox--" (symbol-name (car node)))))
      (error "Unsafe ETAF static View form: %S" node))
    (mapc #'etaf-playground--validate-static-node (cdr node))
    node)
   (t (error "Unsafe ETAF static View value: %S" node))))

(defun etaf-playground-read-static (name)
  "Read and validate NAME's single inert `.etaf' form."
  (with-temp-buffer
    (insert-file-contents (etaf-playground--pair-file name ".etaf"))
    (let ((read-eval nil)
          (form (read (current-buffer))))
      (ignore read-eval)
      (condition-case nil
          (progn (read (current-buffer))
                 (error "ETAF static file contains multiple forms"))
        (end-of-file nil))
      (etaf-playground--validate-static-node form))))

(defun etaf-playground-read-pair (name)
  "Read NAME data, load its companion, and return its root View."
  (let* ((scenario (etaf-playground-scenario name))
         (form (etaf-playground-read-static name))
         (root (plist-get scenario :root-component)))
    (unless (featurep 'etaf-operations-console)
      ;; Use Emacs's normal source/bytecode resolution.  `load-file' forced
      ;; the 39KB companion through the Lisp interpreter on every fresh
      ;; process, making the first retained render look like a layout
      ;; regression.  A compiled companion is the production path; source is
      ;; still the deterministic fallback when no `.elc' exists.
      (load (file-name-sans-extension
             (etaf-playground--pair-file name ".el"))
            nil nil nil))
    (unless (functionp root) (error "Missing root factory: %S" root))
    (funcall root form)))

(defun etaf-playground-mount-example (buffer-name name)
  "Mount pair NAME in BUFFER-NAME."
  (when-let ((runtime (etaf-runtime-for-buffer buffer-name)))
    (etaf-unmount runtime))
  (let ((buffer (etaf-mount buffer-name (etaf-playground-read-pair name))))
    (with-current-buffer buffer (setq etaf-playground-current-example name))
    buffer))

(defun etaf-playground--display-buffer (buffer)
  "Display BUFFER interactively and return it."
  (unless noninteractive (pop-to-buffer buffer))
  buffer)

;;;###autoload
(defun etaf-playground-open (&optional buffer-name)
  "Open the operations-console pair in BUFFER-NAME."
  (interactive)
  (etaf-playground--display-buffer
   (etaf-playground-mount-example
    (or buffer-name etaf-playground-buffer-name) "operations-console")))

;;;###autoload
(defun etaf-playground-open-example (name &optional buffer-name)
  "Open pair NAME in BUFFER-NAME."
  (etaf-playground--display-buffer
   (etaf-playground-mount-example
    (or buffer-name etaf-playground-buffer-name) name)))

;;;###autoload
(defun etaf-playground-reset (&optional buffer-name)
  "Remount the active pair in BUFFER-NAME."
  (interactive)
  (let ((name (or buffer-name etaf-playground-buffer-name)))
    (unless (get-buffer name) (user-error "No Playground pair is mounted"))
    (etaf-playground--display-buffer
     (etaf-playground-mount-example name "operations-console"))))

;;;###autoload
(defun etaf-playground-close (&optional buffer-name)
  "Unmount and kill the Playground BUFFER-NAME."
  (interactive)
  (let* ((name (or buffer-name etaf-playground-buffer-name))
         (buffer (get-buffer name)))
    (when-let ((runtime (and buffer (etaf-runtime-for-buffer buffer))))
      (etaf-unmount runtime))
    (when (buffer-live-p buffer) (kill-buffer buffer))
    buffer))

(provide 'etaf-playground)
;;; etaf-playground.el ends here