giles
c5d2fa8c96
lib/hyperscript/compiler.sx — transforms parsed hyperscript AST into
SX expressions targeting web/lib/dom.sx primitives. Two entry points:
hs-to-sx — AST node → SX expression
hs-to-sx-from-source — source string → SX (tokenize+parse+emit)
Compiler handles:
Expressions: me/it/event, refs, queries, attrs, styles, locals,
arithmetic, comparison, boolean, array literals, property access,
DOM traversal (closest/next/previous/first/last), type conversion,
membership test, exists/empty/matches/contains predicates
Commands: add/remove/toggle class, set (var/attr/style/prop dispatch),
put, if/else, do, wait, wait-for, log, send, trigger, hide, show,
transition, repeat, fetch, call, return, throw, settle, go, append,
tell (rebinds me), for, take, make, install, measure, inc/dec
Features: on (with from/filter/every), init, def, behavior
Maps to SX primitives: dom-add-class, dom-set-attr, dom-set-style,
dom-set-prop, dom-query, dom-closest, dom-dispatch, dom-append, etc.
33 compiler tests across 10 suites. 3076/3076 full build, zero regressions.
Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
242 lines
8.2 KiB
Plaintext
242 lines
8.2 KiB
Plaintext
;; _hyperscript compiler tests
|
|
;; Tests that hs-to-sx (AST → SX) produces correct output
|
|
;; Uses hs-to-sx-from-source for end-to-end source→SX tests
|
|
|
|
;; ── Class commands ────────────────────────────────────────────
|
|
(defsuite
|
|
"hs-emit-classes"
|
|
(deftest
|
|
"add class to me"
|
|
(let
|
|
((sx (hs-to-sx-from-source "add .active to me")))
|
|
(assert= (quote dom-add-class) (first sx))
|
|
(assert= (quote me) (nth sx 1))
|
|
(assert= "active" (nth sx 2))))
|
|
(deftest
|
|
"remove class from target"
|
|
(let
|
|
((sx (hs-to-sx-from-source "remove .old from #box")))
|
|
(assert= (quote dom-remove-class) (first sx))
|
|
(assert= (quote dom-query) (first (nth sx 1)))
|
|
(assert= "old" (nth sx 2))))
|
|
(deftest
|
|
"toggle class"
|
|
(let
|
|
((sx (hs-to-sx-from-source "toggle .visible on me")))
|
|
(assert= (quote hs-toggle-class!) (first sx))
|
|
(assert= (quote me) (nth sx 1)))))
|
|
|
|
;; ── Set command ───────────────────────────────────────────────
|
|
(defsuite
|
|
"hs-emit-set"
|
|
(deftest
|
|
"set variable to value"
|
|
(let
|
|
((sx (hs-to-sx-from-source "set x to 42")))
|
|
(assert= (quote set!) (first sx))
|
|
(assert= (quote x) (nth sx 1))
|
|
(assert= 42 (nth sx 2))))
|
|
(deftest
|
|
"set attribute"
|
|
(let
|
|
((sx (hs-to-sx-from-source "set @title to 'hello'")))
|
|
(assert= (quote dom-set-attr) (first sx))
|
|
(assert= "title" (nth sx 2))
|
|
(assert= "hello" (nth sx 3))))
|
|
(deftest
|
|
"set style"
|
|
(let
|
|
((sx (hs-to-sx-from-source "set *color to 'red'")))
|
|
(assert= (quote dom-set-style) (first sx))
|
|
(assert= "color" (nth sx 2))
|
|
(assert= "red" (nth sx 3)))))
|
|
|
|
;; ── Arithmetic ────────────────────────────────────────────────
|
|
(defsuite
|
|
"hs-emit-arithmetic"
|
|
(deftest
|
|
"addition passes through"
|
|
(let
|
|
((sx (hs-to-sx-from-source "set x to 1 + 2")))
|
|
(let
|
|
((val (nth sx 2)))
|
|
(assert= (quote +) (first val))
|
|
(assert= 1 (nth val 1))
|
|
(assert= 2 (nth val 2)))))
|
|
(deftest
|
|
"comparison emits correctly"
|
|
(let
|
|
((sx (hs-to-sx-from-source "if x == 5 log x end")))
|
|
(let ((cnd (nth sx 1))) (assert= (quote =) (first cnd))))))
|
|
|
|
;; ── Control flow ──────────────────────────────────────────────
|
|
(defsuite
|
|
"hs-emit-control-flow"
|
|
(deftest
|
|
"if-then becomes when"
|
|
(let
|
|
((sx (hs-to-sx-from-source "if true log 1 end")))
|
|
(assert= (quote when) (first sx))))
|
|
(deftest
|
|
"if-else becomes if"
|
|
(let
|
|
((sx (hs-to-sx-from-source "if true log 1 else log 2 end")))
|
|
(assert= (quote if) (first sx))))
|
|
(deftest
|
|
"for becomes for-each"
|
|
(let
|
|
((sx (hs-to-sx-from-source "for item in items log item end")))
|
|
(assert= (quote for-each) (first sx))
|
|
(assert= (quote fn) (first (nth sx 1)))))
|
|
(deftest
|
|
"tell rebinds me"
|
|
(let
|
|
((sx (hs-to-sx-from-source "tell <div/> add .active end")))
|
|
(assert= (quote let) (first sx))
|
|
(assert= (quote me) (first (first (nth sx 1)))))))
|
|
|
|
;; ── DOM commands ──────────────────────────────────────────────
|
|
(defsuite
|
|
"hs-emit-dom-commands"
|
|
(deftest
|
|
"hide sets display none"
|
|
(let
|
|
((sx (hs-to-sx-from-source "hide")))
|
|
(assert= (quote dom-set-style) (first sx))
|
|
(assert= (quote me) (nth sx 1))
|
|
(assert= "display" (nth sx 2))
|
|
(assert= "none" (nth sx 3))))
|
|
(deftest
|
|
"show clears display"
|
|
(let
|
|
((sx (hs-to-sx-from-source "show")))
|
|
(assert= (quote dom-set-style) (first sx))
|
|
(assert= (quote me) (nth sx 1))
|
|
(assert= "" (nth sx 3))))
|
|
(deftest
|
|
"log passes through"
|
|
(let
|
|
((sx (hs-to-sx-from-source "log 'hello'")))
|
|
(assert= (quote log) (first sx))
|
|
(assert= "hello" (nth sx 1))))
|
|
(deftest
|
|
"append becomes dom-append"
|
|
(let
|
|
((sx (hs-to-sx-from-source "append 'text' to me")))
|
|
(assert= (quote dom-append) (first sx)))))
|
|
|
|
;; ── Expressions ───────────────────────────────────────────────
|
|
(defsuite
|
|
"hs-emit-expressions"
|
|
(deftest
|
|
"me emits as symbol"
|
|
(let ((sx (hs-to-sx (list (quote me))))) (assert= (quote me) sx)))
|
|
(deftest
|
|
"ref emits as symbol"
|
|
(let
|
|
((sx (hs-to-sx (list (quote ref) "myVar"))))
|
|
(assert= (quote myVar) sx)))
|
|
(deftest
|
|
"query emits dom-query"
|
|
(let
|
|
((sx (hs-to-sx (list (quote query) ".foo"))))
|
|
(assert= (quote dom-query) (first sx))
|
|
(assert= ".foo" (nth sx 1))))
|
|
(deftest
|
|
"attr emits dom-get-attr"
|
|
(let
|
|
((sx (hs-to-sx (list (quote attr) "href" (list (quote me))))))
|
|
(assert= (quote dom-get-attr) (first sx))
|
|
(assert= "href" (nth sx 2))))
|
|
(deftest
|
|
"exists becomes not nil?"
|
|
(let
|
|
((sx (hs-to-sx (list (quote exists?) (list (quote ref) "x")))))
|
|
(assert= (quote not) (first sx))
|
|
(assert= (quote nil?) (first (nth sx 1)))))
|
|
(deftest
|
|
"array becomes list"
|
|
(let
|
|
((sx (hs-to-sx (list (quote array) 1 2 3))))
|
|
(assert= (quote list) (first sx))
|
|
(assert= 1 (nth sx 1))
|
|
(assert= 3 (nth sx 3)))))
|
|
|
|
;; ── On feature ────────────────────────────────────────────────
|
|
(defsuite
|
|
"hs-emit-on"
|
|
(deftest
|
|
"on click add class"
|
|
(let
|
|
((sx (hs-to-sx-from-source "on click add .active end")))
|
|
(assert= (quote hs-on) (first sx))
|
|
(assert= (quote me) (nth sx 1))
|
|
(assert= "click" (nth sx 2))
|
|
(assert= (quote fn) (first (nth sx 3)))))
|
|
(deftest
|
|
"on click from target"
|
|
(let
|
|
((sx (hs-to-sx-from-source "on click from #btn add .clicked end")))
|
|
(assert= (quote hs-on) (first sx))
|
|
(assert= (quote dom-query) (first (nth sx 1)))))
|
|
(deftest
|
|
"on every click"
|
|
(let
|
|
((sx (hs-to-sx-from-source "on every click add .pulse end")))
|
|
(assert= (quote hs-on-every) (first sx)))))
|
|
|
|
;; ── Def and behavior ─────────────────────────────────────────
|
|
(defsuite
|
|
"hs-emit-def-behavior"
|
|
(deftest
|
|
"def becomes define"
|
|
(let
|
|
((sx (hs-to-sx-from-source "def greet(name) log name end")))
|
|
(assert= (quote define) (first sx))
|
|
(assert= (quote greet) (nth sx 1))
|
|
(assert= (quote fn) (first (nth sx 2)))))
|
|
(deftest
|
|
"init wraps in hs-init"
|
|
(let
|
|
((sx (hs-to-sx-from-source "init log 'ready' end")))
|
|
(assert= (quote hs-init) (first sx))
|
|
(assert= (quote fn) (first (nth sx 1))))))
|
|
|
|
;; ── Return and throw ─────────────────────────────────────────
|
|
(defsuite
|
|
"hs-emit-return-throw"
|
|
(deftest
|
|
"return unwraps to value"
|
|
(let ((sx (hs-to-sx-from-source "return 42"))) (assert= 42 sx)))
|
|
(deftest
|
|
"throw becomes raise"
|
|
(let
|
|
((sx (hs-to-sx-from-source "throw 'oops'")))
|
|
(assert= (quote raise) (first sx))
|
|
(assert= "oops" (nth sx 1))))
|
|
(deftest
|
|
"wait emits hs-wait"
|
|
(let
|
|
((sx (hs-to-sx-from-source "wait 100ms")))
|
|
(assert= (quote hs-wait) (first sx))
|
|
(assert= 100 (nth sx 1))))
|
|
(deftest
|
|
"wait for emits hs-wait-for"
|
|
(let
|
|
((sx (hs-to-sx-from-source "wait for transitionend")))
|
|
(assert= (quote hs-wait-for) (first sx))
|
|
(assert= "transitionend" (nth sx 2)))))
|
|
|
|
;; ── Increment / decrement ────────────────────────────────────
|
|
(defsuite
|
|
"hs-emit-inc-dec"
|
|
(deftest
|
|
"increment attribute"
|
|
(let
|
|
((sx (hs-to-sx-from-source "increment @count")))
|
|
(assert= (quote dom-set-attr) (first sx))))
|
|
(deftest
|
|
"decrement attribute"
|
|
(let
|
|
((sx (hs-to-sx-from-source "decrement @count")))
|
|
(assert= (quote dom-set-attr) (first sx))))) |