;;; etaf-component-frontends-tests.el --- Component frontend contract -*- lexical-binding: t; -*-

;;; Code:

(require 'ert)
(require 'etaf)

(defvar etaf-test-g6b-dsl-setup-count 0)
(defvar etaf-test-g6b-code-setup-count 0)
(defvar etaf-test-g6b-lifecycle nil)

(etaf-define-component etaf-test-g6b-dsl-counter (&key initial)
  :setup
  (progn
    (cl-incf etaf-test-g6b-dsl-setup-count)
    (etaf-ref (or initial 0)))
  :view
  (column :background-color "#102030" :padding-inline 1
    (text :font-weight 'bold
          (expr (format "Count %d" (etaf-value (etaf-state)))))
    (box :ref 'g6b-dsl-increment
         :on-press
         (let ((count (etaf-state)))
           (lambda ()
             (setf (etaf-value count) (1+ (etaf-value count)))))
      "Increment")))

(etaf-define-component etaf-test-g6b-code-counter (&key initial)
  :setup
  (progn
    (cl-incf etaf-test-g6b-code-setup-count)
    (etaf-ref (or initial 0)))
  :render
  (let ((count (etaf-state)))
    (etaf-node
     'column (list :background-color "#102030" :padding-inline 1)
     (list
      (etaf-node 'text (list :font-weight 'bold)
                 (list (format "Count %d" (etaf-value count))))
      (etaf-node
       'box
       (list :ref 'g6b-code-increment
             :on-press
             (lambda ()
               (setf (etaf-value count) (1+ (etaf-value count)))))
       (list "Increment"))))))

(etaf-define-component etaf-test-g6b-nil-state ()
  :setup nil
  :view (text (expr (if (null (etaf-state)) "nil-state" "bad-state"))))

(etaf-define-component etaf-test-g6b-directives (&key selected items)
  :view
  (column
    (text :if selected :key 'selected (expr selected))
    (text :else t :key 'empty "No selection")
    (row :for (item items) :key (car item)
      (text (expr (cdr item))))))

(etaf-define-component etaf-test-g6b-pair (&key item)
  :view
  (fragment
    (text (expr (format "%s-1" (cdr item))))
    (text (expr (format "%s-2" (cdr item))))))

(etaf-define-component etaf-test-g6b-component-loop (&key items)
  :view
  (column
    (etaf-test-g6b-pair :for (item items) :key (car item) :item item)))

(etaf-define-component etaf-test-g6b-key-boundary (&key value)
  :setup
  (list :framework-key (etaf-current-prop 'key) :initial value)
  :view
  (text
   (expr
    (format "%s/%s"
            (plist-get (etaf-state) :initial)
            (or (plist-get (etaf-state) :framework-key) "no-key")))))

(etaf-define-component etaf-test-g6b-invalid-list-result ()
  :render
  (list (etaf-node 'text nil (list "ambiguous"))))

(etaf-define-component etaf-test-g6b-rollback (&key fail)
  :setup (etaf-ref 7)
  :render
  (let ((state (etaf-state)))
    (when fail
      (setf (etaf-value state) 99))
    (etaf-node 'text nil (list (format "Stable %d" (etaf-value state))))))

(etaf-define-component etaf-test-g6b-lifecycle (&key label)
  :setup
  (progn
    (etaf-on-mounted
     (lambda ()
       (setq etaf-test-g6b-lifecycle
             (append etaf-test-g6b-lifecycle '(mounted)))))
    (etaf-on-updated
     (lambda ()
       (setq etaf-test-g6b-lifecycle
             (append etaf-test-g6b-lifecycle '(updated)))))
    (etaf-on-unmounted
     (lambda ()
       (setq etaf-test-g6b-lifecycle
             (append etaf-test-g6b-lifecycle '(unmounted)))))
    (etaf-on-scope-dispose
     (lambda ()
       (setq etaf-test-g6b-lifecycle
             (append etaf-test-g6b-lifecycle '(cleanup)))))
    nil)
  :view (text (expr label)))

(etaf-define-component etaf-test-g6b-provider ()
  :setup
  (progn
    (etaf-provide 'g6b-message "Context")
    (etaf-theme-provide '(:color "#34D399"))
    nil)
  :view (column (slot)))

(etaf-define-component etaf-test-g6b-context-action (&key count on-press)
  :render
  (etaf-node
   'box
   (list :class '(g6b-context-action)
         :ref 'g6b-context-action
         :use (etaf-focusable)
         :on-press on-press)
   (list (format "%s %d" (etaf-inject 'g6b-message "missing") count)))
  :styles
  (styles
   (".g6b-context-action" :background-color "#1F2937")))

(etaf-define-component etaf-test-g6b-dsl-panel ()
  :view
  (column :background-color "#203040" :padding-inline 1
    (row :class 'header (slot :name 'header))
    (box (slot))
    (row :class 'actions (slot :name 'actions))))

(etaf-define-component etaf-test-g6b-code-panel ()
  :render
  (etaf-node
   'column (list :background-color "#203040" :padding-inline 1)
   (list
    (etaf-node 'row (list :class 'header)
               (etaf-current-slot 'header))
    (etaf-node 'box nil (etaf-current-slot 'default))
    (etaf-node 'row (list :class 'actions)
               (etaf-current-slot 'actions)))))

(defun etaf-test-g6b-dsl-counter (&rest _arguments)
  "Ordinary Elisp function colliding with a Component registry name."
  'ordinary-function)

(defun etaf-test-g6b--text (buffer)
  "Return BUFFER text without properties."
  (with-current-buffer buffer
    (substring-no-properties (buffer-string))))

(defun etaf-test-g6b--face-at (buffer regexp)
  "Return BUFFER face at the first REGEXP match."
  (with-current-buffer buffer
    (save-excursion
      (goto-char (point-min))
      (re-search-forward regexp)
      (get-text-property (match-beginning 0) 'face))))

(defun etaf-test-g6b--face-value (face property)
  "Return PROPERTY from anonymous FACE values."
  (cond
   ((and (listp face) (keywordp (car-safe face)))
    (plist-get face property))
   ((listp face)
    (cl-loop for entry in face
             when (and (listp entry) (keywordp (car-safe entry))
                       (plist-member entry property))
             return (plist-get entry property)))))

(ert-deftest etaf-component-frontends-definition-boundary-is-strict ()
  "Definitions choose one frontend and keep exact registry names."
  (should (etaf--component-spec-p
           (gethash 'etaf-test-g6b-dsl-counter etaf--view-registry)))
  (should-not (gethash 'test-g6b-dsl-counter etaf--view-registry))
  (should (eq 'ordinary-function (etaf-test-g6b-dsl-counter)))
  (dolist
      (definition
       '((etaf-define-component invalid-both ()
           :view (box) :render (etaf-node 'box nil nil))
         (etaf-define-component invalid-neither () :setup nil)
         (etaf-define-component invalid-reserved (&key key) :view (box))
         (etaf-define-component invalid-setup-view ()
           :setup (etaf-node 'box nil nil) :view (box))
         (etaf-define-component invalid-render-dsl ()
           :render (etaf-view (box)))))
    (should-error (macroexpand definition)
                  :type 'etaf-component-definition-error)))

(ert-deftest etaf-node-validates-code-mode-structure ()
  "Code nodes accept typed values and reject DSL or raw-list ambiguity."
  (should (etaf--view-node-p
           (etaf-node 'box (list :padding 1) (list "A"))))
  (should (etaf--component-call-p
           (etaf-node 'etaf-test-g6b-dsl-counter
                      (list :initial 1) nil)))
  (should-error (etaf-node 'box (list :if t) nil)
                :type 'etaf-component-call-error)
  (should-error (etaf-node 'box nil '((text "raw")))
                :type 'etaf-component-call-error)
  (should-error (etaf-node 'box nil nil '((header . ("H"))))
                :type 'etaf-component-call-error)
  (should-error (etaf-node 'box (list :key nil) nil)
                :type 'etaf-component-call-error))

(ert-deftest etaf-component-directives-validate-branch-and-loop-grammar ()
  "DSL directives reject ambiguous structure during macro expansion."
  (dolist
      (form
       '((etaf-view (column (text :else t "orphan")))
         (etaf-view
          (column (text :if t :for (item '(1)) :key item "bad")))
         (etaf-view (column (text :for (item '(1)) "missing key")))
         (etaf-view
          (column (text :if nil "a") (text :else maybe "b")))))
    (should-error (macroexpand form) :type 'etaf-view-syntax-error)))

(ert-deftest etaf-component-directives-render-and-retain-keyed-identity ()
  "Branch changes and keyed reorder publish locally with stable item ids."
  (let ((buffer " *etaf-g6b-directives*")
        (selected (etaf-ref nil))
        (items (etaf-ref '((a . "A") (b . "B")))))
    (unwind-protect
        (progn
          (etaf-mount
           buffer
           (lambda ()
             (etaf-view
              (etaf-test-g6b-directives
               :selected (etaf-value selected)
               :items (etaf-value items)))))
          (let* ((runtime (etaf-runtime-for-buffer buffer))
                 (generation (etaf-runtime-current-generation runtime))
                 (range
                  (cl-loop for _identity being the hash-keys of
                           (etaf-generation-identity-index generation)
                           using (hash-values semantic-id)
                           for semantic = (etaf--pvec-get
                                           (etaf-generation-semantic-nodes
                                            generation)
                                           semantic-id)
                           when (and (etaf--semantic-range-p semantic)
                                     (etaf--semantic-range-keyed-key-order
                                      semantic))
                           return semantic))
                 (a-roots
                  (gethash
                   'a
                   (etaf--semantic-range-keyed-item-root-id-index range)))
                 (b-roots
                  (gethash
                   'b
                   (etaf--semantic-range-keyed-item-root-id-index range))))
            (should (string-match-p "No selection"
                                    (etaf-test-g6b--text buffer)))
            (should (string-match-p "A[[:space:]]+B"
                                    (etaf-test-g6b--text buffer)))
            (setf (etaf-value selected) "Selected")
            (setf (etaf-value items) '((b . "B2") (a . "A")))
            (should (string-match-p "Selected"
                                    (etaf-test-g6b--text buffer)))
            (should (string-match-p "B2[[:space:]]+A"
                                    (etaf-test-g6b--text buffer)))
            (let* ((generation (etaf-runtime-current-generation runtime))
                   (next (etaf--pvec-get
                          (etaf-generation-semantic-nodes generation)
                          (etaf--semantic-range-semantic-id range))))
              (should
               (equal
                a-roots
                (gethash
                 'a
                 (etaf--semantic-range-keyed-item-root-id-index next))))
              (should
               (equal
                b-roots
                (gethash
                 'b
                 (etaf--semantic-range-keyed-item-root-id-index next)))))
            (let ((generation (etaf-runtime-current-generation runtime))
                  (text (with-current-buffer buffer (buffer-string))))
              (should-error
               (setf (etaf-value items) '((a . "A") (a . "duplicate")))
               :type 'etaf-component-call-error)
              (should (eq generation
                          (etaf-runtime-current-generation runtime)))
              (should (equal-including-properties
                       text (with-current-buffer buffer (buffer-string)))))))
      (when-let* ((runtime (etaf-runtime-for-buffer buffer)))
        (etaf-unmount runtime))
      (when-let* ((live (get-buffer buffer))) (kill-buffer live)))))

(ert-deftest etaf-component-keyed-loop-owns-transparent-component-spans ()
  "A keyed item may be a transparent multi-root Component without a fake Box."
  (let ((buffer " *etaf-g6b-component-spans*")
        (items (etaf-ref '((a . "A") (b . "B")))))
    (unwind-protect
        (progn
          (etaf-mount
           buffer
           (lambda ()
             (etaf-view
              (etaf-test-g6b-component-loop :items (etaf-value items)))))
          (let* ((runtime (etaf-runtime-for-buffer buffer))
                 (generation (etaf-runtime-current-generation runtime))
                 (range
                  (cl-loop for _identity being the hash-keys of
                           (etaf-generation-identity-index generation)
                           using (hash-values semantic-id)
                           for semantic =
                           (etaf--pvec-get
                            (etaf-generation-semantic-nodes generation)
                            semantic-id)
                           when (and (etaf--semantic-range-p semantic)
                                     (equal
                                      '(a b)
                                      (etaf--semantic-range-keyed-key-order
                                       semantic)))
                           return semantic))
                 (root-index
                  (etaf--semantic-range-keyed-item-root-id-index range))
                 (a-roots (copy-sequence (gethash 'a root-index)))
                 (b-roots (copy-sequence (gethash 'b root-index))))
            (should (string-match-p
                     "A-1[[:space:]]+A-2[[:space:]]+B-1[[:space:]]+B-2"
                     (etaf-test-g6b--text buffer)))
            (should (= 1 (length a-roots)))
            (should (= 1 (length b-roots)))
            (should
             (etaf--semantic-component-p
              (etaf--pvec-get
               (etaf-generation-semantic-nodes generation) (car a-roots))))
            (setf (etaf-value items) '((b . "B2") (a . "A")))
            (setq generation (etaf-runtime-current-generation runtime)
                  range
                  (etaf--pvec-get
                   (etaf-generation-semantic-nodes generation)
                   (etaf--semantic-range-semantic-id range))
                  root-index
                  (etaf--semantic-range-keyed-item-root-id-index range))
            (should (string-match-p
                     "B2-1[[:space:]]+B2-2[[:space:]]+A-1[[:space:]]+A-2"
                     (etaf-test-g6b--text buffer)))
            (should (equal a-roots (gethash 'a root-index)))
            (should (equal b-roots (gethash 'b root-index)))))
      (when-let* ((runtime (etaf-runtime-for-buffer buffer)))
        (etaf-unmount runtime))
      (when-let* ((live (get-buffer buffer))) (kill-buffer live)))))

(ert-deftest etaf-component-frontends-project-default-and-named-slots ()
  "DSL and code Components preserve caller-owned slot order and styling."
  (let ((dsl-buffer " *etaf-g6b-dsl-slots*")
        (code-buffer " *etaf-g6b-code-slots*"))
    (unwind-protect
        (progn
          (etaf-mount
           dsl-buffer
           (etaf-view
            (etaf-test-g6b-dsl-panel
             (slot :name 'header (text :font-weight 'bold "Header"))
             (slot :name 'actions "Actions")
             "Body")))
          (etaf-mount
           code-buffer
           (etaf-node
            'etaf-test-g6b-code-panel nil (list "Body")
            (list
             (cons 'header
                   (list (etaf-node 'text (list :font-weight 'bold)
                                    (list "Header"))))
             (cons 'actions (list "Actions")))))
          (dolist (buffer (list dsl-buffer code-buffer))
            (let ((text (etaf-test-g6b--text buffer)))
              (should (string-match-p
                       "Header[[:space:]]+Body[[:space:]]+Actions" text)))
            (should (eq 'bold
                        (etaf-test-g6b--face-value
                         (etaf-test-g6b--face-at buffer "Header")
                         :weight)))))
      (dolist (buffer-name (list dsl-buffer code-buffer))
        (when-let* ((runtime (etaf-runtime-for-buffer buffer-name)))
          (etaf-unmount runtime))
        (when-let* ((buffer (get-buffer buffer-name)))
          (kill-buffer buffer))))))

(ert-deftest etaf-component-frontends-render-state-layout-style-and-events ()
  "DSL and code Components mount equivalent stateful interactive surfaces."
  (setq etaf-test-g6b-dsl-setup-count 0
        etaf-test-g6b-code-setup-count 0)
  (let ((dsl-buffer " *etaf-g6b-dsl*")
        (code-buffer " *etaf-g6b-code*"))
    (unwind-protect
        (progn
          (etaf-mount dsl-buffer
                      (etaf-view
                       (etaf-test-g6b-dsl-counter :initial 1)))
          (etaf-mount code-buffer
                      (etaf-node 'etaf-test-g6b-code-counter
                                 (list :initial 1) nil))
          (should (= 1 etaf-test-g6b-dsl-setup-count))
          (should (= 1 etaf-test-g6b-code-setup-count))
          (dolist (buffer (list dsl-buffer code-buffer))
            (let ((text (etaf-test-g6b--text buffer)))
              (should (string-match-p "Count 1" text))
              (should (string-match-p "Increment" text))
              (should (= 2 (length (split-string text "\n" t)))))
            (should (eq 'bold
                        (etaf-test-g6b--face-value
                         (etaf-test-g6b--face-at buffer "Count 1")
                         :weight))))
          (let* ((dsl-runtime (etaf-runtime-for-buffer dsl-buffer))
                 (code-runtime (etaf-runtime-for-buffer code-buffer))
                 (dsl-instance
                  (car (hash-table-values (etaf-runtime-instances dsl-runtime))))
                 (code-instance
                  (car (hash-table-values (etaf-runtime-instances code-runtime)))))
            (etaf-dispatch-event dsl-runtime 'g6b-dsl-increment 'press)
            (etaf-dispatch-event code-runtime 'g6b-code-increment 'press)
            (should (string-match-p "Count 2"
                                    (etaf-test-g6b--text dsl-buffer)))
            (should (string-match-p "Count 2"
                                    (etaf-test-g6b--text code-buffer)))
            (should (= 1 etaf-test-g6b-dsl-setup-count))
            (should (= 1 etaf-test-g6b-code-setup-count))
            (should (eq dsl-instance
                        (car (hash-table-values
                              (etaf-runtime-instances dsl-runtime)))))
            (should (eq code-instance
                        (car (hash-table-values
                              (etaf-runtime-instances code-runtime)))))))
      (dolist (buffer-name (list dsl-buffer code-buffer))
        (when-let* ((runtime (etaf-runtime-for-buffer buffer-name)))
          (etaf-unmount runtime))
        (when-let* ((buffer (get-buffer buffer-name)))
          (kill-buffer buffer))))))

(ert-deftest etaf-component-state-distinguishes-nil-from-no-setup ()
  "A completed setup may return nil without becoming setup absence."
  (let ((buffer " *etaf-g6b-nil-state*"))
    (unwind-protect
        (progn
          (etaf-mount buffer (etaf-view (etaf-test-g6b-nil-state)))
          (should (equal "nil-state" (etaf-test-g6b--text buffer))))
      (when-let* ((runtime (etaf-runtime-for-buffer buffer)))
        (etaf-unmount runtime))
      (when-let* ((live (get-buffer buffer))) (kill-buffer live))))
  (should-error (etaf-state) :type 'etaf-component-definition-error))

(ert-deftest etaf-component-key-is-framework-owned-and-render-result-is-typed ()
  "Identity metadata stays outside business props and node lists stay invalid."
  (let ((buffer " *etaf-g6b-key-boundary*")
        (invalid-buffer " *etaf-g6b-invalid-result*"))
    (unwind-protect
        (progn
          (etaf-mount
           buffer
           (etaf-view
            (etaf-test-g6b-key-boundary :key 'stable :value "Business")))
          (should (string-match-p "Business/no-key"
                                  (etaf-test-g6b--text buffer)))
          (should-error
           (etaf-mount
            invalid-buffer
            (etaf-view (etaf-test-g6b-invalid-list-result)))
           :type 'etaf-component-call-error))
      (dolist (buffer-name (list buffer invalid-buffer))
        (when-let* ((runtime (etaf-runtime-for-buffer buffer-name)))
          (etaf-unmount runtime))
        (when-let* ((live (get-buffer buffer-name))) (kill-buffer live))))))

(ert-deftest etaf-component-render-side-effect-rolls-back-completely ()
  "A detectable render mutation preserves the published generation and state."
  (let ((buffer " *etaf-g6b-render-rollback*")
        (fail (etaf-ref nil)))
    (unwind-protect
        (progn
          (etaf-mount
           buffer
           (lambda ()
             (etaf-view
              (etaf-test-g6b-rollback :fail (etaf-value fail)))))
          (let* ((runtime (etaf-runtime-for-buffer buffer))
                 (generation (etaf-runtime-current-generation runtime))
                 (published (with-current-buffer buffer (buffer-string)))
                 (instance
                  (car (hash-table-values (etaf-runtime-instances runtime))))
                 (state (etaf--component-instance-state instance)))
            (should-error (setf (etaf-value fail) t)
                          :type 'etaf-render-write-error)
            (should (eq generation
                        (etaf-runtime-current-generation runtime)))
            (should (equal-including-properties
                     published (with-current-buffer buffer (buffer-string))))
            (should (= 7 (etaf-value state)))))
      (when-let* ((runtime (etaf-runtime-for-buffer buffer)))
        (etaf-unmount runtime))
      (when-let* ((live (get-buffer buffer))) (kill-buffer live)))))

(ert-deftest etaf-component-lifecycle-and-scope-cleanup-are-ordered ()
  "Mount, update, removal, and Scope cleanup each run once in order."
  (let ((buffer " *etaf-g6b-lifecycle*")
        (label (etaf-ref "A")))
    (setq etaf-test-g6b-lifecycle nil)
    (unwind-protect
        (progn
          (etaf-mount
           buffer
           (lambda ()
             (etaf-view
              (etaf-test-g6b-lifecycle :label (etaf-value label)))))
          (should (equal '(mounted) etaf-test-g6b-lifecycle))
          (setf (etaf-value label) "B")
          (should (equal '(mounted updated) etaf-test-g6b-lifecycle))
          (should (string-match-p "B" (etaf-test-g6b--text buffer)))
          (etaf-unmount (etaf-runtime-for-buffer buffer))
          (should (equal '(mounted updated unmounted cleanup)
                         etaf-test-g6b-lifecycle)))
      (when-let* ((runtime (etaf-runtime-for-buffer buffer)))
        (etaf-unmount runtime))
      (when-let* ((live (get-buffer buffer))) (kill-buffer live)))))

(ert-deftest etaf-component-frontends-compose-context-theme-style-and-behavior ()
  "A DSL provider and code Component share Context, Theme, style, and events."
  (let ((buffer " *etaf-g6b-composition*")
        (count (etaf-ref 0)))
    (unwind-protect
        (progn
          (etaf-mount
           buffer
           (lambda ()
             (etaf-view
              (etaf-test-g6b-provider
               (etaf-test-g6b-context-action
                :count (etaf-value count)
                :on-press
                (let ((source count))
                  (lambda ()
                    (setf (etaf-value source)
                          (1+ (etaf-value source))))))))))
          (let* ((runtime (etaf-runtime-for-buffer buffer))
                 (face (etaf-test-g6b--face-at buffer "Context 0"))
                 (props
                  (etaf-runtime-host-props-for
                   runtime 'g6b-context-action)))
            (should (equal "#34D399"
                           (etaf-test-g6b--face-value face :foreground)))
            (should (equal "#1F2937"
                           (etaf-test-g6b--face-value face :background)))
            (should (= 0 (plist-get props :tab-index)))
            (etaf-dispatch-event runtime 'g6b-context-action 'press)
            (should (string-match-p "Context 1"
                                    (etaf-test-g6b--text buffer)))))
      (when-let* ((runtime (etaf-runtime-for-buffer buffer)))
        (etaf-unmount runtime))
      (when-let* ((live (get-buffer buffer))) (kill-buffer live)))))

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