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-arithmetic"
  (deftest
    "addition"
    (let
      ((ast (hs-compile "set x to 1 + 2")))
      (let
        ((val (nth ast 2)))
        (assert= (quote +) (first val))
        (assert= 1 (nth val 1))
        (assert= 2 (nth val 2)))))
  (deftest
    "subtraction"
    (let
      ((ast (hs-compile "set x to 10 - 3")))
      (let
        ((val (nth ast 2)))
        (assert= (quote -) (first val))
        (assert= 10 (nth val 1))
        (assert= 3 (nth val 2)))))
  (deftest
    "multiplication"
    (let
      ((ast (hs-compile "set x to 4 * 5")))
      (let
        ((val (nth ast 2)))
        (assert= (quote *) (first val))
        (assert= 4 (nth val 1))
        (assert= 5 (nth val 2)))))
  (deftest
    "division"
    (let
      ((ast (hs-compile "set x to 10 / 2")))
      (let
        ((val (nth ast 2)))
        (assert= (quote /) (first val))
        (assert= 10 (nth val 1))
        (assert= 2 (nth val 2)))))
  (deftest
    "chained arithmetic"
    (let
      ((ast (hs-compile "set x to 1 + 2 + 3")))
      (let
        ((val (nth ast 2)))
        (assert= (quote +) (first val))
        (assert= 3 (nth val 2))))))

(defsuite
  "hs-parse-unary"
  (deftest
    "not expr"
    (let
      ((ast (hs-compile "if not x end")))
      (let ((cnd (nth ast 1))) (assert= (quote not) (first cnd)))))
  (deftest
    "no expr"
    (let
      ((ast (hs-compile "if no x end")))
      (let ((cnd (nth ast 1))) (assert= (quote no) (first cnd)))))
  (deftest
    "unary minus"
    (let
      ((ast (hs-compile "set x to -5")))
      (let
        ((val (nth ast 2)))
        (assert= (quote -) (first val))
        (assert= 0 (nth val 1))
        (assert= 5 (nth val 2))))))

(defsuite
  "hs-parse-the-of"
  (deftest
    "the innerHTML of me"
    (let
      ((ast (hs-compile "set the innerHTML of me to 'hi'")))
      (let
        ((tgt (nth ast 1)))
        (assert= (make-symbol ".") (first tgt))
        (assert= "innerHTML" (nth tgt 2)))))
  (deftest
    "the as article skip"
    (let
      ((ast (hs-compile "set the result to 5")))
      (let ((tgt (nth ast 1))) (assert= (quote it) (first tgt))))))

(defsuite
  "hs-parse-as-conversion"
  (deftest
    "expr as Int"
    (let
      ((ast (hs-compile "set x to y as Int")))
      (let
        ((val (nth ast 2)))
        (assert= (quote as) (first val))
        (assert= "Int" (nth val 2)))))
  (deftest
    "expr as String"
    (let
      ((ast (hs-compile "set x to count as String")))
      (let
        ((val (nth ast 2)))
        (assert= (quote as) (first val))
        (assert= "String" (nth val 2))))))

(defsuite
  "hs-parse-in-operator"
  (deftest
    "x in collection"
    (let
      ((ast (hs-compile "if x in items end")))
      (let ((cnd (nth ast 1))) (assert= (quote in?) (first cnd))))))

(defsuite
  "hs-parse-array-literals"
  (deftest
    "empty array"
    (let
      ((ast (hs-compile "set x to []")))
      (let
        ((val (nth ast 2)))
        (assert= (quote array) (first val))
        (assert= 1 (len val)))))
  (deftest
    "array with elements"
    (let
      ((ast (hs-compile "set x to [1, 2, 3]")))
      (let
        ((val (nth ast 2)))
        (assert= (quote array) (first val))
        (assert= 4 (len val))
        (assert= 1 (nth val 1))
        (assert= 2 (nth val 2))
        (assert= 3 (nth val 3))))))

(defsuite
  "hs-parse-return-throw"
  (deftest
    "return expr"
    (let
      ((ast (hs-compile "return 42")))
      (assert= (quote return) (first ast))
      (assert= 42 (nth ast 1))))
  (deftest
    "return bare"
    (let
      ((ast (hs-compile "return")))
      (assert= (quote return) (first ast))
      (assert= nil (nth ast 1))))
  (deftest
    "throw expr"
    (let
      ((ast (hs-compile "throw 'error'")))
      (assert= (quote throw) (first ast))
      (assert= "error" (nth ast 1)))))

(defsuite
  "hs-parse-append"
  (deftest
    "append to target"
    (let
      ((ast (hs-compile "append 'hello' to me")))
      (assert= (quote append!) (first ast))
      (assert= "hello" (nth ast 1))
      (assert= (quote me) (first (nth ast 2))))))

(defsuite
  "hs-parse-tell"
  (deftest
    "tell target commands end"
    (let
      ((ast (hs-compile "tell <div/> add .active end")))
      (assert= (quote tell) (first ast))
      (assert= (quote query) (first (nth ast 1)))
      (assert= (quote add-class) (first (nth ast 2))))))

(defsuite
  "hs-parse-for"
  (deftest
    "for x in items end"
    (let
      ((ast (hs-compile "for item in items log item end")))
      (assert= (quote for) (first ast))
      (assert= "item" (nth ast 1))
      (assert= (quote ref) (first (nth ast 2)))
      (assert= (quote log) (first (nth ast 3)))))
  (deftest
    "for with index"
    (let
      ((ast (hs-compile "for item in items index i log item end")))
      (assert= (quote for) (first ast))
      (assert= "item" (nth ast 1)))))

(defsuite
  "hs-parse-make"
  (deftest
    "make a Object"
    (let
      ((ast (hs-compile "make a Object")))
      (assert= (quote make) (first ast))
      (assert= "Object" (nth ast 1))))
  (deftest
    "make a Set called s"
    (let
      ((ast (hs-compile "make a Set called s")))
      (assert= (quote make) (first ast))
      (assert= "Set" (nth ast 1))
      (assert= "s" (nth ast 2)))))

(defsuite
  "hs-parse-install"
  (deftest
    "install behavior"
    (let
      ((ast (hs-compile "install Draggable")))
      (assert= (quote install) (first ast))
      (assert= "Draggable" (nth ast 1))))
  (deftest
    "install with args"
    (let
      ((ast (hs-compile "install Sortable(true)")))
      (assert= (quote install) (first ast))
      (assert= "Sortable" (nth ast 1))
      (assert= true (nth ast 2)))))

(defsuite
  "hs-parse-measure"
  (deftest
    "measure target"
    (let
      ((ast (hs-compile "measure me")))
      (assert= (quote measure) (first ast))
      (assert= (quote me) (first (nth ast 1))))))

(defsuite
  "hs-parse-wait-for"
  (deftest
    "wait for transitionend"
    (let
      ((ast (hs-compile "wait for transitionend")))
      (assert= (quote wait-for) (first ast))
      (assert= "transitionend" (nth ast 1))))
  (deftest
    "wait for click from target"
    (let
      ((ast (hs-compile "wait for click from #btn")))
      (assert= (quote wait-for) (first ast))
      (assert= "click" (nth ast 1))
      (assert= :from (nth ast 2)))))

(defsuite
  "hs-parse-def-behavior"
  (deftest
    "def function"
    (let
      ((ast (hs-compile "def greet(name) log name end")))
      (assert= (quote def) (first ast))
      (assert= "greet" (nth ast 1))
      (assert= 1 (len (nth ast 2)))
      (assert= (quote log) (first (nth ast 3)))))
  (deftest
    "behavior with on handler"
    (let
      ((ast (hs-compile "behavior Clickable on click add .clicked end end")))
      (assert= (quote behavior) (first ast))
      (assert= "Clickable" (nth ast 1))
      (assert= 1 (len (nth ast 3)))))
  (deftest
    "def no params"
    (let
      ((ast (hs-compile "def reset() set x to 0 end")))
      (assert= (quote def) (first ast))
      (assert= "reset" (nth ast 1))
      (assert= 0 (len (nth ast 2))))))

(defsuite
  "hs-parse-render"
  (deftest
    "render component"
    (let
      ((ast (hs-compile "render ~card")))
      (assert= (quote render) (first ast))
      (assert= "~card" (nth ast 1))
      (assert= 0 (len (nth ast 2)))))
  (deftest
    "render with kwargs"
    (let
      ((ast (hs-compile "render ~card :title 'Hello'")))
      (assert= "~card" (nth ast 1))
      (let
        ((kw (nth ast 2)))
        (assert= "title" (first kw))
        (assert= "Hello" (nth kw 1)))))
  (deftest
    "render into target"
    (let
      ((ast (hs-compile "render ~card :title 'Hi' into #box")))
      (assert= "into" (nth ast 3))
      (assert= (quote query) (first (nth ast 4)))))
  (deftest
    "component token in expression"
    (let
      ((ast (hs-compile "set x to ~myComp")))
      (let
        ((val (nth ast 2)))
        (assert= (quote component) (first val))
        (assert= "~myComp" (nth val 1))))))

(defsuite
  "hs-parse-sx-eval"
  (deftest
    "eval with parens extracts raw SX"
    (let
      ((ast (hs-compile "set x to eval (+ 1 2)")))
      (let
        ((val (nth ast 2)))
        (assert= (quote sx-eval) (first val))
        (assert= "(+ 1 2)" (nth val 1)))))
  (deftest
    "eval with string fallback"
    (let
      ((ast (hs-compile "eval '(log 42)'")))
      (assert= (quote sx-eval) (first ast))
      (assert= "(log 42)" (nth ast 1))))
  (deftest
    "eval nested parens"
    (let
      ((ast (hs-compile "set x to eval (map (fn (x) (+ x 1)) items)")))
      (let
        ((val (nth ast 2)))
        (assert= (quote sx-eval) (first val))
        (assert= "(map (fn (x) (+ x 1)) items)" (nth val 1))))))

(defsuite
  "hs-parse-every-modifier"
  (deftest
    "on every click"
    (let
      ((ast (hs-compile "on every click add .pulse end")))
      (assert= (quote on) (first ast))
      (assert= "click" (nth ast 1))
      (assert= :every (nth ast 2))
      (assert= true (nth ast 3)))))

(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))))