;;; etaf-playground-tests.el --- Research Shelf pair contract -*- lexical-binding: t; -*-

;;; Commentary:
;; These tests exercise the generic pair boundary and one real application.
;; The framework tests never reach into the application's model; application
;; tests drive only public refs/events and observe the rendered surface.

;;; Code:
(require 'cl-lib)
(require 'ert)
(require 'package)
(require 'etaf-playground)
(require 'etaf-performance)

(defconst etaf-playground-test--root
  (file-name-directory
   (directory-file-name
    (file-name-directory (or load-file-name buffer-file-name))))
  "Absolute ETAF Playground repository path used by subprocess gates.")

(defun etaf-playground-test--package-description (file)
  "Return the package description parsed from FILE."
  (with-temp-buffer
    (insert-file-contents file)
    (package-buffer-info)))

(defun etaf-playground-test--ensure-app-loaded ()
  "Load the same-basename Research Shelf companion for test setup."
  (unless (featurep 'etaf-research-shelf)
    (load-file (expand-file-name "examples/research-shelf.el"
                                default-directory))))

(ert-deftest etaf-playground-etaf-source-mode-clean-loads-without-runtime ()
  "Opening research-shelf.etaf must not eagerly load ETAF or TP."
  (let ((output (generate-new-buffer " *etaf-source-mode-clean-load*"))
        (program (expand-file-name invocation-name invocation-directory))
        (package-file
         (expand-file-name "etaf-playground.el" etaf-playground-test--root))
        (source-file
         (expand-file-name "examples/research-shelf.etaf"
                           etaf-playground-test--root)))
    (unwind-protect
        (let ((status
               (call-process
                program nil output nil "-Q" "--batch"
                "-L" etaf-playground-test--root
                "-l" package-file
                "--eval"
                (format
                 "(progn (find-file %S) (unless (eq major-mode 'etaf-playground-etaf-mode) (kill-emacs 11)) (when (featurep 'etaf) (kill-emacs 12)) (when (featurep 'tp) (kill-emacs 13)) (when (featurep 'tp-transaction) (kill-emacs 14)) (princ \"ETAF source mode clean-load OK\\n\"))"
                 source-file))))
          (unless (zerop status)
            (ert-fail
             (with-current-buffer output (buffer-string))))
          (with-current-buffer output
            (should (string-match-p "ETAF source mode clean-load OK"
                                    (buffer-string)))))
      (when (buffer-live-p output) (kill-buffer output)))))

(ert-deftest etaf-playground-package-closure-requires-transaction-tp ()
  "Package metadata must reject TP snapshots without tp-transaction.el."
  (let* ((workspace (file-name-directory
                     (directory-file-name etaf-playground-test--root)))
         (tp (etaf-playground-test--package-description
              (expand-file-name "tp/tp.el" workspace)))
         (ebox (etaf-playground-test--package-description
                (expand-file-name "ebox/ebox.el" workspace)))
         (etaf (etaf-playground-test--package-description
                (expand-file-name "etaf/etaf.el" workspace)))
         (playground (etaf-playground-test--package-description
                      (expand-file-name
                       "etaf-playground/etaf-playground.el" workspace))))
    (should (equal (package-desc-version tp) '(1 0 1)))
    (should (equal (package-desc-version ebox) '(2 0 1)))
    (should (member '(tp (1 0 1)) (package-desc-reqs ebox)))
    (should (equal (package-desc-version etaf) '(0 1 1)))
    (should (member '(ebox (2 0 1)) (package-desc-reqs etaf)))
    (should (member '(tp (1 0 1)) (package-desc-reqs etaf)))
    (should (equal (package-desc-version playground) '(0 2 1)))
    (should (member '(etaf (0 1 1)) (package-desc-reqs playground)))
    (should (member '(etaf-ui (0 1 0))
                    (package-desc-reqs playground)))
    (should (member '(etaf-sqlite (0 1 0))
                    (package-desc-reqs playground)))))

(ert-deftest etaf-playground-stale-tp-error-is-actionable ()
  "A stale TP install reports its required package instead of file-missing."
  (let ((original-require (symbol-function 'require)))
    (cl-letf (((symbol-function 'require)
               (lambda (feature &optional filename noerror)
                 (if (eq feature 'etaf)
                     (signal 'file-missing
                             '("Cannot open load file"
                               "No such file or directory"
                               "tp-transaction"))
                   (funcall original-require feature filename noerror)))))
      (let ((condition
             (should-error (etaf-playground--ensure-runtime)
                           :type 'etaf-playground-dependency-error)))
        (should (equal (plist-get (cdr condition) :required-package)
                       '(tp "1.0.1")))
        (should (eq (plist-get (cdr condition) :missing-feature)
                    'tp-transaction))))))

(ert-deftest etaf-playground-unrelated-file-missing-is-preserved ()
  "Runtime loading must not relabel an unrelated missing dependency as TP."
  (let ((original-require (symbol-function 'require))
        (injected
         '(file-missing "Cannot open load file"
                        "No such file or directory"
                        "unrelated-feature")))
    (cl-letf (((symbol-function 'require)
               (lambda (feature &optional filename noerror)
                 (if (eq feature 'etaf)
                     (signal (car injected) (cdr injected))
                   (funcall original-require feature filename noerror)))))
      (should (equal (should-error (etaf-playground--ensure-runtime)
                                   :type 'file-missing)
                     injected)))))

(defun etaf-playground-test--text (buffer)
  "Return BUFFER's plain rendered text."
  (with-current-buffer buffer
    (substring-no-properties (buffer-string))))

(defun etaf-playground-test--row-refs (runtime)
  "Return RUNTIME's visible Research Shelf row refs in stable order."
  (sort
   (delq nil
         (mapcar
          (lambda (entry)
            (let ((ref (car entry)))
              (and (symbolp ref)
                   (string-prefix-p "research-shelf-row-"
                                    (symbol-name ref))
                   ref)))
          (etaf-runtime-handler-entries runtime)))
   (lambda (left right)
     (string< (symbol-name left) (symbol-name right)))))

(defun etaf-playground-test--close (buffer)
  "Close BUFFER when it exists."
  (when (gethash "research-shelf" etaf-playground--sessions)
    (etaf-playground-close "research-shelf"))
  (when (get-buffer buffer)
    (etaf-playground-close buffer)))

(defmacro etaf-playground-test--with-app (variables &rest body)
  "Run BODY with VARIABLES.
VARIABLES is a `(BUFFER DATABASE)' list; the macro creates a temporary SQLite
database and mounts a test buffer before running BODY."
  (declare (indent 1))
  (let ((buffer (car variables))
        (database (cadr variables)))
    (unless (and (symbolp buffer) (symbolp database))
      (error "Expected (BUFFER DATABASE) variables, got %S" variables))
    `(let* ((,database (make-temp-file "etaf-research-shelf-" nil ".sqlite"))
            (,buffer " *etaf-research-shelf-test*"))
       (ignore ,database)
       (etaf-playground-test--ensure-app-loaded)
     (unwind-protect
         (let ((etaf-research-shelf-database-file ,database)
               (etaf-research-shelf-fixture-size 8)
               (etaf-research-shelf-page-size 4))
             (ignore etaf-research-shelf-fixture-size
                     etaf-research-shelf-page-size)
             (ignore etaf-research-shelf-database-file)
             ,@body)
         (etaf-playground-test--close ,buffer)
         (when (file-exists-p ,database)
           (delete-file ,database))))))

(defun etaf-playground-test--open (buffer)
  "Mount Research Shelf in BUFFER with a deterministic headless viewport.

Text assertions should not depend on whether batch Ebox has a selected
window.  GUI verification exercises responsive geometry separately on a real
frame."
  (etaf-playground-mount-example
   buffer "research-shelf" nil '(:viewport-width 1400 :viewport-height 80)))

(ert-deftest etaf-playground-framework-discovers-generic-file-triplets ()
  "Discover examples from files without a business catalog in the framework."
  (should (member "research-shelf" etaf-playground-example-names))
  (let ((entry (etaf-playground-scenario "research-shelf"))
        (framework (with-temp-buffer
                     (insert-file-contents "etaf-playground.el")
                     (buffer-string)))
        (makefile (with-temp-buffer
                    (insert-file-contents "Makefile")
                    (buffer-string)))
        (companion (with-temp-buffer
                     (insert-file-contents "examples/research-shelf.el")
                     (buffer-string))))
    (dolist (key '(:pair :directory :etaf-file :el-file :ecss-file
                   :root-component :companion-feature))
      (should (plist-member entry key)))
    (should (file-readable-p (plist-get entry :etaf-file)))
    (should (file-readable-p (plist-get entry :el-file)))
    (should (file-readable-p (plist-get entry :ecss-file)))
    (should (string-match-p "wildcard examples" makefile))
    (should-not (string-match-p "mindepth 2" makefile))
    (should-not (string-match-p "etaf-playground-catalog" framework))
    (should-not (string-match-p "research-shelf" framework))
    (should-not (string-match-p "operations-console" framework))
    (dolist (section '("DATA / SQLITE SOURCE"
                       "THEME / PALETTE CONTRACT"
                       "STATE / DATA CONTROLLER / ACTIONS"
                       "VIEW / COMPONENTS / COMPOSITION"
                       "ROOT / PLAYGROUND REGISTRATION"))
      (should (string-match-p (regexp-quote section) companion)))))

(ert-deftest etaf-playground-displays-before-responsive-mount ()
  "GUI entry points establish the containing window before Ebox mount."
  (let ((calls nil)
        (noninteractive nil))
    (cl-letf (((symbol-function 'switch-to-buffer)
               (lambda (buffer)
                 (push (list 'display (buffer-name buffer)) calls)
                 buffer))
              ((symbol-function 'etaf-playground-mount-example)
               (lambda (buffer name)
                 (push (list 'mount buffer name) calls)
                 buffer)))
      (etaf-playground--mount-for-display
       " *etaf-playground-display-order*" "research-shelf"))
    (should (equal '(display mount) (mapcar #'car (nreverse calls))))))

(ert-deftest etaf-playground-mount-owns-complete-render-burst ()
  "Source construction and ETAF mount share the host render transaction."
  (let ((buffer " *etaf-playground-burst-test*")
        (inside nil)
        calls)
    (unwind-protect
        (cl-letf (((symbol-function 'ebox-call-with-render-burst)
                   (lambda (function &rest arguments)
                     (push 'begin calls)
                     (setq inside t)
                     (unwind-protect
                         (prog1 (apply function arguments)
                           (push 'end calls))
                       (setq inside nil))))
                  ((symbol-function 'etaf-playground-read-pair)
                   (lambda (_name _session)
                     (should inside)
                     (push 'root calls)
                     'test-view))
                  ((symbol-function 'etaf-mount)
                   (lambda (target view options)
                     (should inside)
                     (should (equal view 'test-view))
                     (should (equal options '(:viewport-width 900)))
                     (push 'mount calls)
                     target)))
          (should (bufferp
                   (etaf-playground-mount-example
                    buffer "test" nil '(:viewport-width 900))))
          (should (equal '(begin root mount end) (nreverse calls))))
      (when (get-buffer buffer) (kill-buffer buffer)))))

(ert-deftest etaf-playground-compile-builds-the-dependency-graph ()
  "Integration builds must compile the framework's dependency graph first."
  (let ((makefile (with-temp-buffer
                    (insert-file-contents "Makefile")
                    (buffer-string))))
    (dolist (dependency '("$(MAKE) -C ../ecss compile"
                          "$(MAKE) -C ../tp compile"
                          "$(MAKE) -C ../ebox compile"
                          "$(MAKE) -C ../etaf compile"
                          "$(MAKE) -C ../etaf-ui compile"
                          "$(MAKE) -C ../etaf-sqlite compile"))
      (should (string-match-p (regexp-quote dependency) makefile)))))

(ert-deftest etaf-playground-performance-gate-runs-before-regressions ()
  "Repeatable exclusive latency gates run before CPU-heavy regressions."
  (let* ((makefile (with-temp-buffer
                     (insert-file-contents "Makefile")
                     (buffer-string)))
         (target (string-match "^perf-check:" makefile))
         (repeatability
          (and target
               (string-match "$(MAKE) perf-repeatability " makefile target)))
         (regressions (and target
                           (string-match "perf-regressions" makefile target))))
    (should target)
    (should repeatability)
    (should regressions)
    (should (< repeatability regressions))
    (should (string-match-p "^perf-prepare: compile" makefile))
    (should (string-match-p "^perf-evaluator:" makefile))
    (should (string-match-p "^perf-repeatability: perf-prepare" makefile))
    (should (string-match-p "scripts/with-performance-lock.sh" makefile))
    (let* ((start (string-match "^perf-repeatability:" makefile))
           (end (string-match "^# Run package regressions" makefile start))
           (body (substring makefile start end))
           (offset 0)
           (count 0))
      (while (string-match "$(MAKE) perf-evaluator" body offset)
        (setq count (1+ count)
              offset (match-end 0)))
      (should (= count 3)))))

(ert-deftest etaf-playground-performance-lock-is-exclusive-and-stale-safe ()
  "The evaluator wrapper serializes runs and clears stale owner locks."
  (let ((script (with-temp-buffer
                  (insert-file-contents "scripts/with-performance-lock.sh")
                  (buffer-string))))
    (dolist (contract '("mkdir \"$PERF_LOCK_DIR\""
                        "kill -0 \"$PERF_LOCK_OWNER\""
                        "rmdir \"$PERF_LOCK_DIR\""
                        "performance evaluator waiting for exclusive host slot"))
      (should (string-match-p (regexp-quote contract) script)))
    (should-not (string-match-p "rm -rf" script))))

(ert-deftest etaf-playground-static-reader-is-inert-and-strict ()
  "Read pair structure as inert data and reject executable AST nodes."
  (let* ((form (etaf-playground-read-static "research-shelf"))
         (tags (plist-get (etaf-playground-scenario "research-shelf")
                          :static-tags)))
    (should (equal (car form) 'research-shelf-shell))
    (should (equal (plist-get (cdr form) :title) "Research Shelf"))
    (should (equal (mapcar #'car
                           (cl-remove-if-not #'consp (cdr form)))
                   '(research-shelf-header-spec
                     research-shelf-filter-specs
                     research-shelf-content-spec
                     research-shelf-footer-spec)))
    (let* ((filters (cl-find-if
                     (lambda (entry) (and (consp entry)
                                          (eq (car entry)
                                              'research-shelf-filter-specs)))
                     (cdr form)))
           (all-filter (cl-find-if
                        (lambda (entry) (and (consp entry)
                                             (eq (car entry)
                                                 'research-shelf-filter-spec)
                                             (eq (plist-get (cdr entry) :key)
                                                 'all)))
                        (cdr filters))))
      (should all-filter))
    (dolist (unsafe '((lambda () 1) (eval '(message "x"))
                      (etaf--private) (ebox--private) (shell-command "x")))
      (should-error (etaf-playground--validate-static-node unsafe tags)
                    :type 'error))))

(ert-deftest etaf-playground-research-shelf-uses-runtime-named-slots ()
  "The companion composes the Shell through ETAF's public named-slot API."
  (let ((source (with-temp-buffer
                  (insert-file-contents "examples/research-shelf.el")
                  (buffer-string))))
    (dolist (slot '("header" "filters" "library" "detail" "footer"))
      (should (string-match-p
               (format "(slot :name '%s" slot)
               source)))
    (should (string-match-p
             "(etaf-define-component etaf-research-shelf-shell ()"
             source))
    (should (string-match-p
             "(etaf-define-component etaf-research-shelf-app"
             source))))

(ert-deftest etaf-playground-ecss-reader-is-inert-and-usable ()
  "Read the optional style companion as validated static Component styles."
  (let ((form (etaf-playground-read-ecss "research-shelf")))
    (should (equal 'styles (car form)))
    (should (= 6 (length (cdr form))))
    (dolist (rule (cdr form))
      (should (stringp (car rule)))
      (should (cl-every #'keywordp
                        (cl-loop for (key _value) on (cdr rule) by #'cddr
                                 collect key))))))

(ert-deftest etaf-playground-workspace-switches-three-source-buffers ()
  "One session switches `.etaf', `.el', and `.ecss' beside one preview."
  (etaf-playground-test--with-app (buffer database)
    (ignore buffer)
    (let ((etaf-research-shelf-database-file database)
          (source (etaf-playground-open-example "research-shelf")))
      (ignore etaf-research-shelf-database-file)
      (let* ((session (buffer-local-value 'etaf-playground-session source))
             (preview (etaf-playground-session-preview-buffer session)))
        (should (etaf-playground-session-p session))
        (should (= 3 (length (etaf-playground-session-source-buffers session))))
        (should (equal ".etaf"
                       (etaf-playground-session-active-extension session)))
        (should (etaf-runtime-p (etaf-runtime-for-buffer preview)))
        (etaf-playground-show-el source)
        (should (equal ".el"
                       (etaf-playground-session-active-extension session)))
        (etaf-playground-show-ecss source)
        (should (equal ".ecss"
                       (etaf-playground-session-active-extension session)))
        (should (equal (etaf-playground-read-ecss "research-shelf" session)
                       (etaf-component-styles 'etaf-research-shelf-shell)))))))

(ert-deftest etaf-playground-show-session-uses-display-buffer-action ()
  "Workspace display delegates preview placement to standard `display-buffer'."
  (let* ((source (get-buffer-create " *etaf-display-source*"))
         (preview (get-buffer-create " *etaf-display-preview*"))
         (session
          (etaf-playground--session-create
           :name "display-test"
           :source-buffers (list (cons ".etaf" source))
           :preview-buffer preview
           :active-extension ".etaf"))
         (action '((display-buffer-in-side-window)
                   (side . right)
                   (window-width . 0.4)))
         calls)
    (unwind-protect
        (let ((noninteractive nil)
              (etaf-playground-display-action action))
          (cl-letf (((symbol-function 'current-window-configuration)
                     (lambda () 'saved-window-configuration))
                    ((symbol-function 'switch-to-buffer)
                     (lambda (buffer)
                       (push (list 'source buffer) calls)
                       buffer))
                    ((symbol-function 'display-buffer)
                     (lambda (buffer supplied-action)
                       (push (list 'preview buffer supplied-action) calls)
                       (selected-window)))
                    ((symbol-function 'delete-other-windows)
                     (lambda (&rest _)
                       (ert-fail "Workspace must not delete user windows")))
                    ((symbol-function 'split-window-right)
                     (lambda (&rest _)
                       (ert-fail "Workspace must not split windows directly")))
                    ((symbol-function 'split-window-below)
                     (lambda (&rest _)
                       (ert-fail "Workspace must not split windows directly"))))
            (should (windowp (etaf-playground--show-session session))))
          (should
           (equal
            (list (list 'source source) (list 'preview preview action))
            (nreverse calls)))
          (should (eq (etaf-playground-session-preview-window session)
                      (selected-window))))
      (when (buffer-live-p source) (kill-buffer source))
      (when (buffer-live-p preview) (kill-buffer preview)))))

(ert-deftest etaf-playground-source-tabs-have-buttons-and-shortcuts ()
  "Source tabs work through both header buttons and keyboard shortcuts."
  (etaf-playground-test--with-app (buffer database)
    (ignore buffer)
    (let ((etaf-research-shelf-database-file database)
          (source (etaf-playground-open-example "research-shelf")))
      (ignore etaf-research-shelf-database-file)
      (with-current-buffer source
        (should (eq #'etaf-playground-refresh
                    (key-binding (kbd "C-c C-c"))))
        (should (eq #'etaf-playground-show-etaf
                    (key-binding (kbd "C-c 1"))))
        (should (eq #'etaf-playground-show-el
                    (key-binding (kbd "C-c 2"))))
        (should (eq #'etaf-playground-show-ecss
                    (key-binding (kbd "C-c 3"))))
        (call-interactively (key-binding (kbd "C-c C-c")))
        (should (etaf-runtime-p
                 (etaf-runtime-for-buffer
                  (etaf-playground-session-preview-buffer
                   etaf-playground-session))))
        (let* ((header (etaf-playground--source-header))
               (position (string-match " EL" header)))
          (should position)
          (should (get-text-property position 'button header))
          (should (equal ".el"
                         (get-text-property position 'button-data header)))
          (etaf-playground--activate-source-tab
           (propertize " EL " 'etaf-playground-extension ".el"))
          (should (equal ".el"
                         (etaf-playground-session-active-extension
                          etaf-playground-session)))
          (should-not (string-match-p "Compile App" header)))))))

(ert-deftest etaf-playground-direct-etaf-c-c-c-opens-workspace ()
  "The source render command opens a workspace for a directly opened `.etaf'."
  (etaf-playground-test--with-app (buffer database)
    (ignore buffer)
    (let* ((etaf-research-shelf-database-file database)
           (source (find-file-noselect
                    (expand-file-name "examples/research-shelf.etaf"
                                      default-directory))))
      (ignore etaf-research-shelf-database-file)
      (unwind-protect
          (let ((mount-count 0)
                (original-mount
                 (symbol-function 'etaf-playground-mount-example)))
            (cl-letf (((symbol-function 'etaf-playground-mount-example)
                       (lambda (&rest arguments)
                         (cl-incf mount-count)
                         (apply original-mount arguments))))
              (with-current-buffer source
                (should (eq #'etaf-playground-refresh
                            (key-binding (kbd "C-c C-c"))))
                (should (etaf-playground-refresh source))
                (let ((session
                       (buffer-local-value 'etaf-playground-session source)))
                  (should (etaf-playground-session-p session))
                  (should (etaf-runtime-p
                           (etaf-runtime-for-buffer
                            (etaf-playground-session-preview-buffer session)))))))
            (should (= mount-count 1)))
        (when (buffer-live-p source)
          (etaf-playground-close source))))))

(ert-deftest etaf-playground-does-not-remap-source-buffer ()
  "The Research Shelf surface does not remap the source editor buffer."
  (etaf-playground-test--with-app (buffer database)
    (ignore buffer)
    (let ((etaf-research-shelf-database-file database))
      (ignore etaf-research-shelf-database-file)
      (let* ((source (etaf-playground-open-example "research-shelf"))
             (session (buffer-local-value 'etaf-playground-session source))
             (preview (etaf-playground-session-preview-buffer session)))
        (should (null (buffer-local-value 'face-remapping-alist source)))
        (should (etaf-runtime-p (etaf-runtime-for-buffer preview)))))))

(ert-deftest etaf-playground-refresh-uses-unsaved-etaf-source ()
  "Refreshing a workspace reads the current source buffer, not disk only."
  (etaf-playground-test--with-app (buffer database)
    (ignore buffer)
    (let ((etaf-research-shelf-database-file database)
          (source (etaf-playground-open-example "research-shelf")))
      (ignore etaf-research-shelf-database-file)
      (with-current-buffer source
        (goto-char (point-min))
        (search-forward ":title \"Research Shelf\"")
        (replace-match ":title \"Research Shelf (edited)\"" t t)
        (set-buffer-modified-p t))
      (should (etaf-playground-refresh source))
      (let* ((session (buffer-local-value 'etaf-playground-session source))
             (preview (etaf-playground-session-preview-buffer session))
             (form (etaf-playground-read-static "research-shelf" session)))
        (should (equal "Research Shelf (edited)"
                       (plist-get (cdr form) :title)))
        (should (string-match-p "edited"
                                (etaf-playground-test--text preview)))))))

(ert-deftest etaf-playground-refresh-reloads-unsaved-el-companion ()
  "Refreshing a dirty `.el' companion redefines its consumer intentionally."
  (etaf-playground-test--with-app (buffer database)
    (ignore buffer)
    (let ((etaf-research-shelf-database-file database)
          (source (etaf-playground-open-example "research-shelf")))
      (ignore etaf-research-shelf-database-file)
      (let* ((session (buffer-local-value 'etaf-playground-session source))
             (el (etaf-playground--source-buffer session ".el")))
        (with-current-buffer el
          (goto-char (point-max))
          (insert "\n;; dirty companion reload sentinel\n")
          (set-buffer-modified-p t))
        (should (etaf-playground-refresh source))
        (should-not (etaf-playground-session-companion-dirty-p session))
        (should (etaf-runtime-p
                 (etaf-runtime-for-buffer
                  (etaf-playground-session-preview-buffer session))))))))

(ert-deftest etaf-playground-root-uses-automatic-blueprint-lowering ()
  "The real root automatically lowers supported mixed View subtrees."
  (etaf-playground-test--with-app (buffer database)
    (etaf-compiler-clear-cache)
    (let* ((before (etaf-compiler-statistics))
           (instantiations (plist-get before :instantiations))
           (cache-entries (plist-get before :static-cache-entries)))
      (etaf-playground-test--open buffer)
      (let* ((after (etaf-compiler-statistics))
             (blueprint (plist-get after :last-blueprint)))
        (should (> (plist-get after :instantiations) instantiations))
        (should (> (plist-get after :static-cache-entries) cache-entries))
        (should (> (plist-get blueprint :dynamic-nodes) 0))
        (should (> (plist-get blueprint :hole-count) 0))))))

(ert-deftest etaf-playground-pair-mounts-sqlite-backed-surface ()
  "Mounting the pair initializes SQLite and renders the real app shell."
  (etaf-playground-test--with-app (buffer database)
    (etaf-playground-test--open buffer)
    (should (etaf-runtime-p (etaf-runtime-for-buffer buffer)))
    (should (file-exists-p database))
    (let ((text (etaf-playground-test--text buffer))
          (runtime (etaf-runtime-for-buffer buffer)))
      (should (string-match-p "Research Shelf" text))
      (should (string-match-p "8 items · SQLite-backed" text))
      (should (string-match-p "The Shape of Tools" text))
      (dolist (ref '(research-shelf-filter-all research-shelf-filter-reading
                     research-shelf-filter-unread research-shelf-filter-finished
                     research-shelf-filter-starred research-shelf-reload
                     research-shelf-page-size research-shelf-add
                     research-shelf-page-next
                     research-shelf-theme-toggle))
        (should (etaf-runtime-handler-for runtime ref))))))

(ert-deftest etaf-playground-research-shelf-uses-window-document-height ()
  "Research Shelf fills the viewport without creating a root scroll owner."
  (etaf-playground-test--with-app (buffer database)
    (etaf-playground-mount-example
     buffer "research-shelf" nil
     '(:viewport-width 900 :viewport-height 40))
    (let* ((state (ebox--buffer-render-state (get-buffer buffer)))
           (root (plist-get state :root-node)))
      (should (equal (plist-get root :height) '(viewport-height)))
      (should (= (plist-get root :min-height) 0))
      (should-not (plist-get state :scroll-region-ids)))))

(ert-deftest etaf-playground-fixture-supports-realistic-page-counts ()
  "The Playground can mount a larger deterministic fixture for pressure runs."
  (etaf-playground-test--ensure-app-loaded)
  (let ((database (make-temp-file "etaf-research-shelf-large-" nil ".sqlite"))
        (buffer " *etaf-research-shelf-large-test*"))
    (unwind-protect
        (let ((etaf-research-shelf-database-file database)
              (etaf-research-shelf-fixture-size 32)
              (etaf-research-shelf-page-size 8))
          (ignore etaf-research-shelf-database-file
                  etaf-research-shelf-fixture-size
                  etaf-research-shelf-page-size)
          (etaf-playground-mount-example buffer "research-shelf")
          (let ((text (etaf-playground-test--text buffer)))
            (should (string-match-p "32 items · SQLite-backed" text))
            (should (string-match-p "Page 1 / 4" text)))
          (should (file-exists-p database)))
      (etaf-playground-test--close buffer)
      (when (file-exists-p database)
        (delete-file database)))))

(ert-deftest etaf-playground-row-selection-is-repeatable ()
  "Repeated DataGrid row presses replace one selected identity."
  (etaf-playground-test--with-app (buffer database)
    (etaf-playground-test--open buffer)
    (let ((runtime (etaf-runtime-for-buffer buffer)))
      (dolist (entry '((research-shelf-row-1 research-shelf-row-2
                        "The best tools make attention feel larger")
                       (research-shelf-row-2 research-shelf-row-1
                        "Look again at the relationship between image and power")
                       (research-shelf-row-1 research-shelf-row-2
                        "The best tools make attention feel larger")
                       (research-shelf-row-2 research-shelf-row-1
                        "Look again at the relationship between image and power")))
        (let ((selected (nth 0 entry))
              (other (nth 1 entry))
              (detail (nth 2 entry)))
          (should (etaf-runtime-handler-for runtime selected))
          (etaf-focus runtime selected)
          (etaf-dispatch-event runtime selected 'press)
          (let ((text (etaf-playground-test--text buffer)))
            (should (string-match-p (regexp-quote detail) text)))
          (should (string-match-p
                   "selected"
                   (or (plist-get
                        (etaf-runtime-host-props-for runtime selected)
                        :class)
                       "")))
          (should-not
           (string-match-p
            "selected"
            (or (plist-get (etaf-runtime-host-props-for runtime other)
                           :class)
                ""))))))))

(ert-deftest etaf-playground-row-observer-on-off-is-exact ()
  "Observation preserves one real row mutation and its retained identity."
  (etaf-playground-test--with-app (buffer database)
    (etaf-playground-test--open buffer)
    (let* ((runtime (etaf-runtime-for-buffer buffer))
           (surface
            (lambda ()
              (with-current-buffer buffer
                (buffer-substring (point-min) (point-max))))))
      ;; Materialize the same lazy TP paint contribution before either side of
      ;; the equivalence comparison.  The observer remains detached here.
      (etaf-dispatch-event runtime 'research-shelf-row-2 'press)
      (etaf-dispatch-event runtime 'research-shelf-row-1 'press)
      (let* ((generation-before (etaf-runtime-generation runtime))
           (result-off
            (etaf-dispatch-event runtime 'research-shelf-row-2 'press))
           (generation-off (etaf-runtime-generation runtime))
           (output-off (funcall surface)))
        (should (= 1 (- generation-off generation-before)))
        (should (string-match-p
                 "selected"
                 (or (plist-get
                      (etaf-runtime-host-props-for
                       runtime 'research-shelf-row-2)
                      :class)
                     "")))
        (etaf-dispatch-event runtime 'research-shelf-row-1 'press)
        (etaf-performance-clear)
        (etaf-performance-start runtime)
        (let* ((generation-before-on (etaf-runtime-generation runtime))
               (result-on
                (etaf-dispatch-event runtime 'research-shelf-row-2 'press))
               (generation-on (etaf-runtime-generation runtime))
               (output-on (funcall surface))
               (operation (car (etaf-performance-records)))
               (providers
                (mapcar #'etaf-performance-stage-provider
                        (etaf-performance-operation-stages operation))))
          (should (equal result-off result-on))
          (should (= (- generation-off generation-before)
                     (- generation-on generation-before-on)))
          (should (equal-including-properties output-off output-on))
          (should (equal providers '(tp ebox etaf)))
          (should (string-match-p
                   "selected"
                   (or (plist-get
                        (etaf-runtime-host-props-for
                         runtime 'research-shelf-row-2)
                        :class)
                       ""))))
        (etaf-performance-stop runtime)))))

(ert-deftest etaf-playground-filters-and-pagination-reload-data ()
  "Filter and pager refs drive the SQLite-backed Data Controller."
  (etaf-playground-test--with-app (buffer database)
    (etaf-playground-test--open buffer)
    (let ((runtime (etaf-runtime-for-buffer buffer)))
      ;; Move the selected identity through the old page first.  The following
      ;; filter reorders keyed Range items; generated cell Host addresses must
      ;; remain scoped by item key rather than inheriting their new position.
      (dolist (ref (etaf-playground-test--row-refs runtime))
        (etaf-dispatch-event runtime ref 'press))
      (etaf-dispatch-event runtime 'research-shelf-filter-reading 'press)
      (dolist (ref (etaf-playground-test--row-refs runtime))
        (etaf-dispatch-event runtime ref 'press))
      (let ((text (etaf-playground-test--text buffer)))
        (should (string-match-p "Showing Reading" text))
        (should (string-match-p "Designing for Calm" text))
        (should-not (string-match-p "Ways of Seeing" text)))
      (etaf-dispatch-event runtime 'research-shelf-filter-all 'press)
      (let ((page-one (etaf-playground-test--text buffer)))
        (should (string-match-p "The Shape of Tools" page-one))
        (should-not (string-match-p "The Craftsman" page-one)))
      (etaf-dispatch-event runtime 'research-shelf-page-next 'press)
      (let ((page-two (etaf-playground-test--text buffer)))
        (should (string-match-p "Page 2 / 2" page-two))
        (should (string-match-p "The Craftsman" page-two))
        (should-not (string-match-p "The Shape of Tools" page-two)))
      (etaf-dispatch-event runtime 'research-shelf-page-previous 'press)
      (let ((page-one-again (etaf-playground-test--text buffer)))
        (should (string-match-p "Page 1 / 2" page-one-again))
        (should (string-match-p "The Shape of Tools" page-one-again)))
      (cl-letf (((symbol-function 'read-number)
                 (lambda (&rest _) 6)))
        (etaf-dispatch-event runtime 'research-shelf-page-size 'press))
      (should (string-match-p "Rows 6 ✎"
                              (etaf-playground-test--text buffer)))
      (should (string-match-p "Page 1 / 2"
                              (etaf-playground-test--text buffer)))
      (cl-letf (((symbol-function 'read-number)
                 (lambda (&rest _) 0)))
        (should-error
         (etaf-dispatch-event runtime 'research-shelf-page-size 'press)
         :type 'user-error)))))

(ert-deftest etaf-playground-workspace-reflows-at-responsive-widths ()
  "Workspace cards share a row when wide and wrap in document order."
  (etaf-playground-test--with-app (buffer database)
    (etaf-playground-test--open buffer)
    (cl-labels
        ((line-of (label)
           (with-current-buffer buffer
             (save-excursion
               (goto-char (point-min))
               (search-forward label)
               (line-number-at-pos (match-beginning 0)))))
         (layout-at (width)
           (ebox-surface-update-buffer-viewport (get-buffer buffer) width 80)
           (list (line-of "Library")
                 (line-of "Reading queue")
                 (line-of "Selected item"))))
      (pcase-let ((`(,filter-line ,list-line ,detail-line)
                   (layout-at 1600)))
        ;; Different child Components may start their first text baseline one
        ;; line apart while still sharing the same wide Flex row.
        (should (<= (abs (- filter-line list-line)) 1))
        (should (<= (- detail-line list-line) 1)))
      (pcase-let ((`(,filter-line ,list-line ,detail-line)
                   (layout-at 900)))
        (should (<= (abs (- filter-line list-line)) 1))
        (should (> detail-line list-line)))
      (pcase-let ((`(,filter-line ,list-line ,detail-line)
                   (layout-at 600)))
        (should (< filter-line list-line))
        (should (< list-line detail-line))))))

(ert-deftest etaf-playground-mutations-persist-and-refresh ()
  "Add and mutate actions persist through the SQLite source and refresh UI."
  (etaf-playground-test--with-app (buffer database)
    (etaf-playground-test--open buffer)
    (let ((runtime (etaf-runtime-for-buffer buffer)))
      (etaf-dispatch-event runtime 'research-shelf-row-1 'press)
      (etaf-dispatch-event runtime 'research-shelf-progress 'press)
      (should (string-match-p "Progress saved"
                              (etaf-playground-test--text buffer)))
      (etaf-dispatch-event runtime 'research-shelf-star 'press)
      (should (string-match-p "Removed star"
                              (etaf-playground-test--text buffer)))
      (etaf-dispatch-event runtime 'research-shelf-archive 'press)
      (should (equal t
                     (plist-get
                      (etaf-runtime-host-props-for runtime
                                                   'research-shelf-finish)
                      :disabled)))
      (etaf-dispatch-event runtime 'research-shelf-add 'press)
      (should (string-match-p "Added to your shelf"
                              (etaf-playground-test--text buffer)))
      (should (file-exists-p database)))))

(ert-deftest etaf-playground-theme-and-lifecycle-are-repeatable ()
  "Theme changes and reset/close do not leave a stale mounted runtime."
  (etaf-playground-test--with-app (buffer database)
    (etaf-playground-test--open buffer)
    (let ((runtime (etaf-runtime-for-buffer buffer)))
      (etaf-dispatch-event runtime 'research-shelf-row-1 'press)
      (let (dark-output light-output)
        (dotimes (cycle 2)
          (etaf-dispatch-event runtime 'research-shelf-theme-toggle 'press)
          (with-current-buffer buffer
            (let ((output (buffer-substring (point-min) (point-max))))
              (if (zerop cycle)
                  (setq dark-output output)
                (should (equal-including-properties output dark-output)))))
        (etaf-dispatch-event runtime 'research-shelf-theme-toggle 'press)
          (with-current-buffer buffer
            (let ((output (buffer-substring (point-min) (point-max))))
              (if (zerop cycle)
                  (setq light-output output)
                (should (equal-including-properties output light-output)))))))
      (should (string-match-p "The Shape of Tools"
                              (etaf-playground-test--text buffer)))
      (should (or (string-match-p "☑ Dark"
                                  (etaf-playground-test--text buffer))
                  (string-match-p "☐ Dark"
                                  (etaf-playground-test--text buffer))))
      ;; Theme-only Host reconstruction must preserve nested Component
      ;; backend anchors for the next unrelated interaction.
      (let ((generation (etaf-runtime-generation runtime)))
        (etaf-dispatch-event runtime 'research-shelf-filter-reading 'press)
        (should (= (etaf-runtime-generation runtime) (1+ generation)))
        (should (eq runtime (etaf-runtime-for-buffer buffer)))))
    (etaf-playground-reset buffer)
    (should (etaf-runtime-p (etaf-runtime-for-buffer buffer))))
  (should-not (get-buffer " *etaf-research-shelf-test*")))

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