giles
770c7fd821
Two hyperscript extensions beyond stock:
render ~component :key val [into|before|after target]
Tokenizer: ~ + ident → component token type
Parser: render command with kwargs and optional position
Compiler: emits (render-to-html ~comp :key val) or
(hs-put! (render-to-html ...) pos target)
Bridges hyperscript flow to SX component rendering
eval (sx-expression) — SX escape hatch
Inside eval (...), content is SX syntax (not hyperscript)
Parser: collect-sx-source extracts balanced parens from raw source
Compiler: sx-parse at compile time, inlines AST directly
Result: SX runs in handler scope — hyperscript variables visible!
Also supports string form: eval '(+ 1 2)' for backward compat
set name to "Giles"
set greeting to eval (str "Hello " name) -- name is visible!
16 new tests (parser + compiler + integration).
3127/3127 full build, zero regressions.
Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
290 lines
9.6 KiB
Plaintext
290 lines
9.6 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-render"
|
|
(deftest
|
|
"render emits render-to-html"
|
|
(let
|
|
((sx (hs-to-sx-from-source "render ~card")))
|
|
(assert= (quote render-to-html) (first sx))
|
|
(assert= (quote ~card) (nth sx 1))))
|
|
(deftest
|
|
"render with kwargs emits keywords"
|
|
(let
|
|
((sx (hs-to-sx-from-source "render ~card :title 'Hi'")))
|
|
(assert= (quote render-to-html) (first sx))
|
|
(assert= (quote ~card) (nth sx 1))
|
|
(assert= (make-keyword "title") (nth sx 2))
|
|
(assert= "Hi" (nth sx 3))))
|
|
(deftest
|
|
"render into emits hs-put!"
|
|
(let
|
|
((sx (hs-to-sx-from-source "render ~card into #box")))
|
|
(assert= (quote hs-put!) (first sx))
|
|
(assert= (quote render-to-html) (first (nth sx 1)))
|
|
(assert= "into" (nth sx 2))))
|
|
(deftest
|
|
"component ref emits symbol"
|
|
(let
|
|
((sx (hs-to-sx (list (quote component) "~badge"))))
|
|
(assert= (quote ~badge) sx))))
|
|
|
|
;; ── Increment / decrement ────────────────────────────────────
|
|
(defsuite
|
|
"hs-emit-sx-eval"
|
|
(deftest
|
|
"eval inlines SX at compile time"
|
|
(let
|
|
((sx (hs-to-sx-from-source "set x to eval (+ 1 2)")))
|
|
(assert= (quote set!) (first sx))
|
|
(let
|
|
((val (nth sx 2)))
|
|
(assert= (quote +) (first val))
|
|
(assert= 1 (nth val 1))
|
|
(assert= 2 (nth val 2)))))
|
|
(deftest
|
|
"eval preserves variable refs"
|
|
(let
|
|
((sx (hs-to-sx-from-source "eval (log x)")))
|
|
(assert= (quote log) (first sx))
|
|
(assert= (quote x) (nth sx 1)))))
|
|
|
|
(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)))))
|
|
|
|
(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))))) |