rose-ash/spec/tests/test-hyperscript-parser.sx

;; _hyperscript parser tests
;; Tests that hs-compile (tokenize + parse) produces correct SX AST

;; ── Basic commands ────────────────────────────────────────────────
(defsuite
  "hs-parse-basic-commands"
  (deftest
    "add class to me"
    (let
      ((ast (hs-compile "add .foo")))
      (assert= (list (quote add-class) "foo" (list (quote me))) ast)))
  (deftest
    "add class to target"
    (let
      ((ast (hs-compile "add .active to #btn")))
      (assert=
        (list (quote add-class) "active" (list (quote query) "#btn"))
        ast)))
  (deftest
    "remove class from me"
    (let
      ((ast (hs-compile "remove .hidden")))
      (assert= (list (quote remove-class) "hidden" (list (quote me))) ast)))
  (deftest
    "remove class from target"
    (let
      ((ast (hs-compile "remove .active from #nav")))
      (assert=
        (list (quote remove-class) "active" (list (quote query) "#nav"))
        ast)))
  (deftest
    "toggle class on me"
    (let
      ((ast (hs-compile "toggle .open")))
      (assert= (list (quote toggle-class) "open" (list (quote me))) ast)))
  (deftest
    "toggle class on target"
    (let
      ((ast (hs-compile "toggle .visible on #modal")))
      (assert=
        (list (quote toggle-class) "visible" (list (quote query) "#modal"))
        ast)))
  (deftest
    "toggle between two classes"
    (let
      ((ast (hs-compile "toggle between .red and .blue")))
      (assert=
        (list (quote toggle-between) "red" "blue" (list (quote me)))
        ast)))
  (deftest
    "toggle between on target"
    (let
      ((ast (hs-compile "toggle between .on and .off on #lamp")))
      (assert=
        (list
          (quote toggle-between)
          "on"
          "off"
          (list (quote query) "#lamp"))
        ast))))

;; ── Assignment commands ───────────────────────────────────────────
(defsuite
  "hs-parse-assignment"
  (deftest
    "set property to string"
    (let
      ((ast (hs-compile "set my.innerHTML to \"hello\"")))
      (assert=
        (list
          (quote set!)
          (list (quote .) (list (quote me)) "innerHTML")
          "hello")
        ast)))
  (deftest
    "set id property to value"
    (let
      ((ast (hs-compile "set #d1.textContent to \"foo\"")))
      (assert=
        (list
          (quote set!)
          (list (quote .) (list (quote query) "#d1") "textContent")
          "foo")
        ast)))
  (deftest
    "put into"
    (let
      ((ast (hs-compile "put \"Clicked\" into my.innerHTML")))
      (assert=
        (list
          (quote set!)
          (list (quote .) (list (quote me)) "innerHTML")
          "Clicked")
        ast)))
  (deftest
    "put before"
    (let
      ((ast (hs-compile "put \"<hr>\" before #content")))
      (assert=
        (list (quote put!) "<hr>" "before" (list (quote query) "#content"))
        ast)))
  (deftest
    "put after"
    (let
      ((ast (hs-compile "put \"<hr>\" after #content")))
      (assert=
        (list (quote put!) "<hr>" "after" (list (quote query) "#content"))
        ast))))

;; ── Event handlers ────────────────────────────────────────────────
(defsuite
  "hs-parse-events"
  (deftest
    "on click add class"
    (let
      ((ast (hs-compile "on click add .called")))
      (assert=
        (list
          (quote on)
          "click"
          (list (quote add-class) "called" (list (quote me))))
        ast)))
  (deftest
    "on click from target"
    (let
      ((ast (hs-compile "on click from #bar add .clicked")))
      (assert=
        (list
          (quote on)
          "click"
          :from (list (quote query) "#bar")
          (list (quote add-class) "clicked" (list (quote me))))
        ast)))
  (deftest
    "on event with filter"
    (let
      ((ast (hs-compile "on click[buttons==0] log event")))
      (assert= (quote on) (first ast))
      (assert= "click" (nth ast 1))))
  (deftest
    "on with command sequence"
    (let
      ((ast (hs-compile "on click add .one then add .two")))
      (assert= (quote on) (first ast))
      (let
        ((body (last ast)))
        (assert= (quote do) (first body))
        (assert= 2 (len (rest body)))))))

;; ── Sequencing ────────────────────────────────────────────────────
(defsuite
  "hs-parse-sequencing"
  (deftest
    "then chains commands"
    (let
      ((ast (hs-compile "add .a then add .b then add .c")))
      (assert= (quote do) (first ast))
      (assert= 3 (len (rest ast)))))
  (deftest
    "wait then add"
    (let
      ((ast (hs-compile "wait 100ms then add .done")))
      (assert= (quote do) (first ast))
      (assert= (list (quote wait) 100) (nth ast 1))
      (assert=
        (list (quote add-class) "done" (list (quote me)))
        (nth ast 2))))
  (deftest
    "wait seconds"
    (let
      ((ast (hs-compile "wait 2s then add .done")))
      (assert= (quote do) (first ast))
      (assert= (list (quote wait) 2000) (nth ast 1)))))

;; ── Conditional ───────────────────────────────────────────────────
(defsuite
  "hs-parse-conditional"
  (deftest
    "if then end"
    (let
      ((ast (hs-compile "if true add .x end")))
      (assert= (quote if) (first ast))
      (assert= true (nth ast 1))
      (assert= (list (quote add-class) "x" (list (quote me))) (nth ast 2))))
  (deftest
    "if else end"
    (let
      ((ast (hs-compile "if true add .a else add .b end")))
      (assert= (quote if) (first ast))
      (assert= (list (quote add-class) "a" (list (quote me))) (nth ast 2))
      (assert= (list (quote add-class) "b" (list (quote me))) (nth ast 3)))))

;; ── Special commands ──────────────────────────────────────────────
(defsuite
  "hs-parse-special-commands"
  (deftest
    "log expression"
    (let
      ((ast (hs-compile "log event")))
      (assert= (list (quote log) (list (quote event))) ast)))
  (deftest
    "increment attribute"
    (let
      ((ast (hs-compile "increment @count")))
      (assert=
        (list
          (quote increment!)
          (list (quote attr) "count" (list (quote me))))
        ast)))
  (deftest
    "decrement attribute"
    (let
      ((ast (hs-compile "decrement @score")))
      (assert=
        (list
          (quote decrement!)
          (list (quote attr) "score" (list (quote me))))
        ast)))
  (deftest
    "hide"
    (let
      ((ast (hs-compile "hide")))
      (assert= (list (quote hide) (list (quote me))) ast)))
  (deftest
    "show target"
    (let
      ((ast (hs-compile "show #panel")))
      (assert= (list (quote show) (list (quote query) "#panel")) ast)))
  (deftest
    "settle"
    (let
      ((ast (hs-compile "settle")))
      (assert= (list (quote settle)) ast))))

;; ── Send and trigger ──────────────────────────────────────────────
(defsuite
  "hs-parse-send-trigger"
  (deftest
    "send event to target"
    (let
      ((ast (hs-compile "send custom to #d1")))
      (assert= (quote send) (first ast))
      (assert= "custom" (nth ast 1))
      (assert= (list (quote query) "#d1") (last ast))))
  (deftest
    "trigger event on target"
    (let
      ((ast (hs-compile "trigger reset on #form")))
      (assert=
        (list (quote trigger) "reset" (list (quote query) "#form"))
        ast)))
  (deftest
    "trigger event on me"
    (let
      ((ast (hs-compile "trigger click")))
      (assert= (list (quote trigger) "click" (list (quote me))) ast))))

;; ── DOM traversal ─────────────────────────────────────────────────
(defsuite
  "hs-parse-dom-traversal"
  (deftest
    "closest class"
    (let
      ((ast (hs-compile "log closest .card")))
      (assert= (quote log) (first ast))
      (assert= (quote closest) (first (nth ast 1)))
      (assert= ".card" (nth (nth ast 1) 1))))
  (deftest
    "next sibling"
    (let
      ((ast (hs-compile "log next .item")))
      (assert= (quote next) (first (nth ast 1)))))
  (deftest
    "previous sibling"
    (let
      ((ast (hs-compile "log previous .item")))
      (assert= (quote previous) (first (nth ast 1))))))

;; ── Expressions ───────────────────────────────────────────────────
(defsuite
  "hs-parse-expressions"
  (deftest
    "property chain"
    (let
      ((ast (hs-compile "log my.style.color")))
      (assert= (quote log) (first ast))
      (let
        ((expr (nth ast 1)))
        (assert= (quote .) (first expr))
        (assert= "color" (nth expr 2)))))
  (deftest
    "it reference"
    (let
      ((ast (hs-compile "log it")))
      (assert= (list (quote log) (list (quote it))) ast)))
  (deftest
    "comparison is empty"
    (let
      ((ast (hs-compile "if result is empty add .hidden end")))
      (assert= (quote if) (first ast))
      (assert= (list (quote empty?) (list (quote it))) (nth ast 1))))
  (deftest
    "comparison is not"
    (let
      ((ast (hs-compile "if result is not null add .ok end")))
      (assert= (quote if) (first ast))
      (assert= (quote not) (first (nth ast 1)))))
  (deftest
    "exists predicate"
    (let
      ((ast (hs-compile "if #panel exists show #panel end")))
      (assert= (quote if) (first ast))
      (assert= (quote exists?) (first (nth ast 1)))))
  (deftest
    "attribute ref"
    (let
      ((ast (hs-compile "log @data-id")))
      (assert=
        (list (quote log) (list (quote attr) "data-id" (list (quote me))))
        ast)))
  (deftest
    "style ref"
    (let
      ((ast (hs-compile "log *color")))
      (assert=
        (list (quote log) (list (quote style) "color" (list (quote me))))
        ast)))
  (deftest
    "local ref"
    (let
      ((ast (hs-compile "log :myVar")))
      (assert= (list (quote log) (list (quote local) "myVar")) ast)))
  (deftest
    "selector query"
    (let
      ((ast (hs-compile "log <div.card/>")))
      (assert= (list (quote log) (list (quote query) "div.card")) ast))))

;; ── Repeat ────────────────────────────────────────────────────────
(defsuite
  "hs-parse-repeat"
  (deftest
    "repeat forever"
    (let
      ((ast (hs-compile "repeat forever add .pulse then settle end")))
      (assert= (quote repeat) (first ast))
      (assert= (list (quote forever)) (nth ast 1))))
  (deftest
    "repeat N times"
    (let
      ((ast (hs-compile "repeat 3 times add .flash then settle end")))
      (assert= (quote repeat) (first ast))
      (assert= (list (quote times) 3) (nth ast 1)))))

;; ── Fetch and call ────────────────────────────────────────────────
(defsuite
  "hs-parse-fetch-call"
  (deftest
    "fetch url"
    (let
      ((ast (hs-compile "fetch \"/api/data\"")))
      (assert= (quote fetch) (first ast))
      (assert= "/api/data" (nth ast 1))))
  (deftest
    "fetch as text"
    (let
      ((ast (hs-compile "fetch \"/api/data\" as text")))
      (assert= "text" (nth ast 2))))
  (deftest
    "call function"
    (let
      ((ast (hs-compile "call alert(\"hello\")")))
      (assert= (quote call) (first ast))
      (assert= "alert" (nth ast 1))
      (assert= "hello" (nth ast 2)))))

;; ── Full expressions (matching tokenizer conformance) ─────────────
(defsuite
  "hs-parse-conformance"
  (deftest
    "on click add .called → full AST"
    (let
      ((ast (hs-compile "on click add .called")))
      (assert=
        (list
          (quote on)
          "click"
          (list (quote add-class) "called" (list (quote me))))
        ast)))
  (deftest
    "toggle between .foo and .bar → full AST"
    (let
      ((ast (hs-compile "toggle between .foo and .bar")))
      (assert=
        (list (quote toggle-between) "foo" "bar" (list (quote me)))
        ast)))
  (deftest
    "wait 100ms then add .done → full AST"
    (let
      ((ast (hs-compile "wait 100ms then add .done")))
      (assert=
        (list
          (quote do)
          (list (quote wait) 100)
          (list (quote add-class) "done" (list (quote me))))
        ast)))
  (deftest
    "increment @count → full AST"
    (let
      ((ast (hs-compile "increment @count")))
      (assert=
        (list
          (quote increment!)
          (list (quote attr) "count" (list (quote me))))
        ast)))
  (deftest
    "on click from #bar add .clicked → full AST"
    (let
      ((ast (hs-compile "on click from #bar add .clicked")))
      (assert=
        (list
          (quote on)
          "click"
          :from (list (quote query) "#bar")
          (list (quote add-class) "clicked" (list (quote me))))
        ast))))