Step 18 (part 2): _hyperscript parser — token stream → SX AST
lib/hyperscript/parser.sx — parses token stream from hs-tokenize into SX AST forms. Covers: Commands: add/remove/toggle class, set/put, log, hide/show, settle Events: on with from/filter, command sequences Sequencing: then, wait (with time units) Conditionals: if/then/else/end Expressions: property chains, it, comparisons, exists, refs DOM traversal: closest, next, previous Send/trigger events to targets Repeat: forever, N times Fetch/call with argument lists 55 tests across 12 suites. 3005/3005 full build, zero regressions. Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
@@ -1310,6 +1310,7 @@ let run_spec_tests env test_files =
|
||||
load_module "parser-combinators.sx" lib_dir;
|
||||
let hs_dir = Filename.concat lib_dir "hyperscript" in
|
||||
load_module "tokenizer.sx" hs_dir;
|
||||
load_module "parser.sx" hs_dir;
|
||||
load_module "types.sx" lib_dir;
|
||||
load_module "sx-swap.sx" lib_dir;
|
||||
(* Shared templates: TW styling engine *)
|
||||
|
||||
584
lib/hyperscript/parser.sx
Normal file
584
lib/hyperscript/parser.sx
Normal file
@@ -0,0 +1,584 @@
|
||||
;; _hyperscript parser — token stream → SX AST
|
||||
;;
|
||||
;; Input: list of {:type T :value V :pos P} tokens from hs-tokenize
|
||||
;; Output: SX AST forms that map to runtime primitives
|
||||
|
||||
;; ── Parser entry point ────────────────────────────────────────────
|
||||
(define
|
||||
hs-parse
|
||||
(fn
|
||||
(tokens)
|
||||
(let
|
||||
((p 0) (tok-len (len tokens)))
|
||||
(define tp (fn () (if (< p tok-len) (nth tokens p) nil)))
|
||||
(define
|
||||
tp-type
|
||||
(fn () (let ((t (tp))) (if t (get t "type") "eof"))))
|
||||
(define
|
||||
tp-val
|
||||
(fn () (let ((t (tp))) (if t (get t "value") nil))))
|
||||
(define
|
||||
adv!
|
||||
(fn () (let ((t (nth tokens p))) (set! p (+ p 1)) t)))
|
||||
(define at-end? (fn () (or (>= p tok-len) (= (tp-type) "eof"))))
|
||||
(define
|
||||
match-kw
|
||||
(fn
|
||||
(kw)
|
||||
(if
|
||||
(and (= (tp-type) "keyword") (= (tp-val) kw))
|
||||
(do (adv!) true)
|
||||
nil)))
|
||||
(define
|
||||
expect-kw!
|
||||
(fn
|
||||
(kw)
|
||||
(if
|
||||
(match-kw kw)
|
||||
true
|
||||
(error (str "Expected '" kw "' at position " p)))))
|
||||
(define
|
||||
parse-dur
|
||||
(fn
|
||||
(val)
|
||||
(let
|
||||
((slen (len val)))
|
||||
(cond
|
||||
((and (>= slen 3) (= (substring val (- slen 2) slen) "ms"))
|
||||
(string->number (substring val 0 (- slen 2))))
|
||||
((and (>= slen 2) (= (nth val (- slen 1)) "s"))
|
||||
(* 1000 (string->number (substring val 0 (- slen 1)))))
|
||||
(true (string->number val))))))
|
||||
(define
|
||||
parse-poss-tail
|
||||
(fn
|
||||
(owner)
|
||||
(let
|
||||
((typ (tp-type)) (val (tp-val)))
|
||||
(cond
|
||||
((or (= typ "ident") (= typ "keyword"))
|
||||
(do (adv!) (parse-prop-chain (list (quote .) owner val))))
|
||||
((= typ "class")
|
||||
(let
|
||||
((prop (get (adv!) "value")))
|
||||
(parse-prop-chain (list (quote .) owner prop))))
|
||||
(true owner)))))
|
||||
(define
|
||||
parse-prop-chain
|
||||
(fn
|
||||
(base)
|
||||
(if
|
||||
(and (= (tp-type) "class") (not (at-end?)))
|
||||
(let
|
||||
((prop (get (adv!) "value")))
|
||||
(parse-prop-chain (list (quote .) base prop)))
|
||||
base)))
|
||||
(define
|
||||
parse-trav
|
||||
(fn
|
||||
(kind)
|
||||
(let
|
||||
((typ (tp-type)) (val (tp-val)))
|
||||
(cond
|
||||
((= typ "selector")
|
||||
(do (adv!) (list kind val (list (quote me)))))
|
||||
((= typ "class")
|
||||
(do (adv!) (list kind (str "." val) (list (quote me)))))
|
||||
((= typ "id")
|
||||
(do (adv!) (list kind (str "#" val) (list (quote me)))))
|
||||
(true (list kind "*" (list (quote me))))))))
|
||||
(define
|
||||
parse-pos-kw
|
||||
(fn
|
||||
(kind)
|
||||
(let
|
||||
((typ (tp-type)) (val (tp-val)))
|
||||
(let
|
||||
((sel (cond ((= typ "selector") (do (adv!) val)) ((= typ "class") (do (adv!) (str "." val))) ((= typ "id") (do (adv!) (str "#" val))) (true "*"))))
|
||||
(if
|
||||
(match-kw "in")
|
||||
(list kind sel (parse-expr))
|
||||
(list kind sel))))))
|
||||
(define
|
||||
parse-atom
|
||||
(fn
|
||||
()
|
||||
(let
|
||||
((typ (tp-type)) (val (tp-val)))
|
||||
(cond
|
||||
((= typ "number") (do (adv!) (parse-dur val)))
|
||||
((= typ "string") (do (adv!) val))
|
||||
((and (= typ "keyword") (= val "true")) (do (adv!) true))
|
||||
((and (= typ "keyword") (= val "false")) (do (adv!) false))
|
||||
((and (= typ "keyword") (= val "null")) (do (adv!) nil))
|
||||
((and (= typ "keyword") (= val "me"))
|
||||
(do (adv!) (list (quote me))))
|
||||
((and (= typ "keyword") (or (= val "it") (= val "result")))
|
||||
(do (adv!) (list (quote it))))
|
||||
((and (= typ "keyword") (= val "event"))
|
||||
(do (adv!) (list (quote event))))
|
||||
((and (= typ "keyword") (= val "target"))
|
||||
(do (adv!) (list (quote .) (list (quote event)) "target")))
|
||||
((and (= typ "keyword") (= val "detail"))
|
||||
(do (adv!) (list (quote .) (list (quote event)) "detail")))
|
||||
((and (= typ "keyword") (= val "my"))
|
||||
(do (adv!) (parse-poss-tail (list (quote me)))))
|
||||
((and (= typ "keyword") (= val "its"))
|
||||
(do (adv!) (parse-poss-tail (list (quote it)))))
|
||||
((and (= typ "keyword") (= val "closest"))
|
||||
(do (adv!) (parse-trav (quote closest))))
|
||||
((and (= typ "keyword") (= val "next"))
|
||||
(do (adv!) (parse-trav (quote next))))
|
||||
((and (= typ "keyword") (= val "previous"))
|
||||
(do (adv!) (parse-trav (quote previous))))
|
||||
((and (= typ "keyword") (= val "first"))
|
||||
(do (adv!) (parse-pos-kw (quote first))))
|
||||
((and (= typ "keyword") (= val "last"))
|
||||
(do (adv!) (parse-pos-kw (quote last))))
|
||||
((= typ "id")
|
||||
(do (adv!) (list (quote query) (str "#" val))))
|
||||
((= typ "selector") (do (adv!) (list (quote query) val)))
|
||||
((= typ "attr")
|
||||
(do (adv!) (list (quote attr) val (list (quote me)))))
|
||||
((= typ "style")
|
||||
(do (adv!) (list (quote style) val (list (quote me)))))
|
||||
((= typ "local") (do (adv!) (list (quote local) val)))
|
||||
((= typ "class") (do (adv!) (str "." val)))
|
||||
((= typ "ident") (do (adv!) (list (quote ref) val)))
|
||||
((= typ "paren-open")
|
||||
(do
|
||||
(adv!)
|
||||
(let
|
||||
((expr (parse-expr)))
|
||||
(if (= (tp-type) "paren-close") (adv!) nil)
|
||||
expr)))
|
||||
(true nil)))))
|
||||
(define
|
||||
parse-poss
|
||||
(fn
|
||||
(obj)
|
||||
(cond
|
||||
((and (= (tp-type) "op") (= (tp-val) "'s"))
|
||||
(do (adv!) (parse-poss-tail obj)))
|
||||
((= (tp-type) "class") (parse-prop-chain obj))
|
||||
(true obj))))
|
||||
(define
|
||||
parse-cmp
|
||||
(fn
|
||||
(left)
|
||||
(let
|
||||
((typ (tp-type)) (val (tp-val)))
|
||||
(cond
|
||||
((and (= typ "op") (or (= val "==") (= val "!=") (= val "<") (= val ">") (= val "<=") (= val ">=")))
|
||||
(do
|
||||
(adv!)
|
||||
(let
|
||||
((right (parse-expr)))
|
||||
(list (if (= val "==") (quote =) val) left right))))
|
||||
((and (= typ "keyword") (= val "is"))
|
||||
(do
|
||||
(adv!)
|
||||
(cond
|
||||
((match-kw "not")
|
||||
(if
|
||||
(match-kw "empty")
|
||||
(list (quote not) (list (quote empty?) left))
|
||||
(let
|
||||
((right (parse-expr)))
|
||||
(list (quote not) (list (quote =) left right)))))
|
||||
((match-kw "empty") (list (quote empty?) left))
|
||||
(true
|
||||
(let
|
||||
((right (parse-expr)))
|
||||
(list (quote =) left right))))))
|
||||
((and (= typ "keyword") (= val "exists"))
|
||||
(do (adv!) (list (quote exists?) left)))
|
||||
((and (= typ "keyword") (= val "matches"))
|
||||
(do (adv!) (list (quote matches?) left (parse-expr))))
|
||||
((and (= typ "keyword") (= val "contains"))
|
||||
(do (adv!) (list (quote contains?) left (parse-expr))))
|
||||
((and (= typ "keyword") (= val "and"))
|
||||
(do (adv!) (list (quote and) left (parse-expr))))
|
||||
((and (= typ "keyword") (= val "or"))
|
||||
(do (adv!) (list (quote or) left (parse-expr))))
|
||||
(true left)))))
|
||||
(define
|
||||
parse-expr
|
||||
(fn
|
||||
()
|
||||
(let
|
||||
((left (parse-atom)))
|
||||
(if
|
||||
(nil? left)
|
||||
nil
|
||||
(let ((left2 (parse-poss left))) (parse-cmp left2))))))
|
||||
(define
|
||||
parse-tgt-kw
|
||||
(fn (kw default) (if (match-kw kw) (parse-expr) default)))
|
||||
(define
|
||||
parse-add-cmd
|
||||
(fn
|
||||
()
|
||||
(if
|
||||
(= (tp-type) "class")
|
||||
(let
|
||||
((cls (get (adv!) "value")))
|
||||
(let
|
||||
((tgt (parse-tgt-kw "to" (list (quote me)))))
|
||||
(list (quote add-class) cls tgt)))
|
||||
nil)))
|
||||
(define
|
||||
parse-remove-cmd
|
||||
(fn
|
||||
()
|
||||
(if
|
||||
(= (tp-type) "class")
|
||||
(let
|
||||
((cls (get (adv!) "value")))
|
||||
(let
|
||||
((tgt (parse-tgt-kw "from" (list (quote me)))))
|
||||
(list (quote remove-class) cls tgt)))
|
||||
nil)))
|
||||
(define
|
||||
parse-toggle-cmd
|
||||
(fn
|
||||
()
|
||||
(cond
|
||||
((match-kw "between")
|
||||
(if
|
||||
(= (tp-type) "class")
|
||||
(let
|
||||
((cls1 (get (adv!) "value")))
|
||||
(expect-kw! "and")
|
||||
(if
|
||||
(= (tp-type) "class")
|
||||
(let
|
||||
((cls2 (get (adv!) "value")))
|
||||
(let
|
||||
((tgt (parse-tgt-kw "on" (list (quote me)))))
|
||||
(list (quote toggle-between) cls1 cls2 tgt)))
|
||||
nil))
|
||||
nil))
|
||||
((= (tp-type) "class")
|
||||
(let
|
||||
((cls (get (adv!) "value")))
|
||||
(let
|
||||
((tgt (parse-tgt-kw "on" (list (quote me)))))
|
||||
(list (quote toggle-class) cls tgt))))
|
||||
(true nil))))
|
||||
(define
|
||||
parse-set-cmd
|
||||
(fn
|
||||
()
|
||||
(let
|
||||
((tgt (parse-expr)))
|
||||
(expect-kw! "to")
|
||||
(let ((value (parse-expr))) (list (quote set!) tgt value)))))
|
||||
(define
|
||||
parse-put-cmd
|
||||
(fn
|
||||
()
|
||||
(let
|
||||
((value (parse-expr)))
|
||||
(cond
|
||||
((match-kw "into") (list (quote set!) (parse-expr) value))
|
||||
((match-kw "before")
|
||||
(list (quote put!) value "before" (parse-expr)))
|
||||
((match-kw "after")
|
||||
(list (quote put!) value "after" (parse-expr)))
|
||||
(true
|
||||
(error (str "Expected into/before/after at position " p)))))))
|
||||
(define
|
||||
parse-if-cmd
|
||||
(fn
|
||||
()
|
||||
(let
|
||||
((cnd (parse-expr)))
|
||||
(let
|
||||
((then-body (parse-cmd-list)))
|
||||
(let
|
||||
((else-body (if (or (match-kw "else") (match-kw "otherwise")) (parse-cmd-list) nil)))
|
||||
(match-kw "end")
|
||||
(if
|
||||
else-body
|
||||
(list (quote if) cnd then-body else-body)
|
||||
(list (quote if) cnd then-body)))))))
|
||||
(define
|
||||
parse-wait-cmd
|
||||
(fn
|
||||
()
|
||||
(if
|
||||
(= (tp-type) "number")
|
||||
(let
|
||||
((tok (adv!)))
|
||||
(list (quote wait) (parse-dur (get tok "value"))))
|
||||
(list (quote wait) 0))))
|
||||
(define
|
||||
parse-detail-dict
|
||||
(fn
|
||||
()
|
||||
(adv!)
|
||||
(define
|
||||
dd-collect
|
||||
(fn
|
||||
(acc)
|
||||
(if
|
||||
(or (= (tp-type) "paren-close") (at-end?))
|
||||
(do (if (= (tp-type) "paren-close") (adv!) nil) acc)
|
||||
(let
|
||||
((key (get (adv!) "value")))
|
||||
(if (= (tp-type) "colon") (adv!) nil)
|
||||
(let
|
||||
((val (parse-expr)))
|
||||
(if (= (tp-type) "comma") (adv!) nil)
|
||||
(dd-collect (append acc (list key val))))))))
|
||||
(cons (quote dict) (dd-collect (list)))))
|
||||
(define
|
||||
parse-send-cmd
|
||||
(fn
|
||||
()
|
||||
(let
|
||||
((name (get (adv!) "value")))
|
||||
(let
|
||||
((dtl (if (= (tp-type) "paren-open") (parse-detail-dict) nil)))
|
||||
(let
|
||||
((tgt (parse-tgt-kw "to" (list (quote me)))))
|
||||
(if
|
||||
dtl
|
||||
(list (quote send) name dtl tgt)
|
||||
(list (quote send) name tgt)))))))
|
||||
(define
|
||||
parse-trigger-cmd
|
||||
(fn
|
||||
()
|
||||
(let
|
||||
((name (get (adv!) "value")))
|
||||
(let
|
||||
((tgt (parse-tgt-kw "on" (list (quote me)))))
|
||||
(list (quote trigger) name tgt)))))
|
||||
(define parse-log-cmd (fn () (list (quote log) (parse-expr))))
|
||||
(define parse-inc-cmd (fn () (list (quote increment!) (parse-expr))))
|
||||
(define parse-dec-cmd (fn () (list (quote decrement!) (parse-expr))))
|
||||
(define
|
||||
parse-hide-cmd
|
||||
(fn
|
||||
()
|
||||
(let
|
||||
((tgt (if (at-end?) (list (quote me)) (if (or (= (tp-type) "id") (= (tp-type) "selector")) (parse-expr) (list (quote me))))))
|
||||
(list (quote hide) tgt))))
|
||||
(define
|
||||
parse-show-cmd
|
||||
(fn
|
||||
()
|
||||
(let
|
||||
((tgt (if (at-end?) (list (quote me)) (if (or (= (tp-type) "id") (= (tp-type) "selector")) (parse-expr) (list (quote me))))))
|
||||
(list (quote show) tgt))))
|
||||
(define
|
||||
parse-transition-cmd
|
||||
(fn
|
||||
()
|
||||
(let
|
||||
((prop (get (adv!) "value")))
|
||||
(expect-kw! "to")
|
||||
(let
|
||||
((value (parse-expr)))
|
||||
(let
|
||||
((dur (if (match-kw "over") (if (= (tp-type) "number") (parse-dur (get (adv!) "value")) 400) nil)))
|
||||
(let
|
||||
((tgt (parse-tgt-kw "on" (list (quote me)))))
|
||||
(if
|
||||
dur
|
||||
(list (quote transition) prop value dur tgt)
|
||||
(list (quote transition) prop value tgt))))))))
|
||||
(define
|
||||
parse-repeat-cmd
|
||||
(fn
|
||||
()
|
||||
(let
|
||||
((mode (cond ((match-kw "forever") (list (quote forever))) ((match-kw "while") (list (quote while) (parse-expr))) ((match-kw "until") (list (quote until) (parse-expr))) ((= (tp-type) "number") (let ((n (parse-dur (get (adv!) "value")))) (expect-kw! "times") (list (quote times) n))) (true (list (quote forever))))))
|
||||
(let
|
||||
((body (parse-cmd-list)))
|
||||
(match-kw "end")
|
||||
(list (quote repeat) mode body)))))
|
||||
(define
|
||||
parse-fetch-cmd
|
||||
(fn
|
||||
()
|
||||
(let
|
||||
((url (parse-expr)))
|
||||
(let
|
||||
((fmt (if (match-kw "as") (get (adv!) "value") "json")))
|
||||
(list (quote fetch) url fmt)))))
|
||||
(define
|
||||
parse-call-args
|
||||
(fn
|
||||
()
|
||||
(adv!)
|
||||
(define
|
||||
ca-collect
|
||||
(fn
|
||||
(acc)
|
||||
(if
|
||||
(or (= (tp-type) "paren-close") (at-end?))
|
||||
(do (if (= (tp-type) "paren-close") (adv!) nil) acc)
|
||||
(let
|
||||
((arg (parse-expr)))
|
||||
(if (= (tp-type) "comma") (adv!) nil)
|
||||
(ca-collect (append acc (list arg)))))))
|
||||
(ca-collect (list))))
|
||||
(define
|
||||
parse-call-cmd
|
||||
(fn
|
||||
()
|
||||
(let
|
||||
((name (get (adv!) "value")))
|
||||
(if
|
||||
(= (tp-type) "paren-open")
|
||||
(let
|
||||
((args (parse-call-args)))
|
||||
(cons (quote call) (cons name args)))
|
||||
(list (quote call) name)))))
|
||||
(define
|
||||
parse-take-cmd
|
||||
(fn
|
||||
()
|
||||
(if
|
||||
(= (tp-type) "class")
|
||||
(let
|
||||
((cls (get (adv!) "value")))
|
||||
(let
|
||||
((tgt (parse-tgt-kw "from" (list (quote me)))))
|
||||
(list (quote take) cls tgt)))
|
||||
nil)))
|
||||
(define
|
||||
parse-go-cmd
|
||||
(fn () (match-kw "to") (list (quote go) (parse-expr))))
|
||||
(define
|
||||
parse-cmd
|
||||
(fn
|
||||
()
|
||||
(let
|
||||
((typ (tp-type)) (val (tp-val)))
|
||||
(cond
|
||||
((and (= typ "keyword") (= val "add"))
|
||||
(do (adv!) (parse-add-cmd)))
|
||||
((and (= typ "keyword") (= val "remove"))
|
||||
(do (adv!) (parse-remove-cmd)))
|
||||
((and (= typ "keyword") (= val "toggle"))
|
||||
(do (adv!) (parse-toggle-cmd)))
|
||||
((and (= typ "keyword") (= val "set"))
|
||||
(do (adv!) (parse-set-cmd)))
|
||||
((and (= typ "keyword") (= val "put"))
|
||||
(do (adv!) (parse-put-cmd)))
|
||||
((and (= typ "keyword") (= val "if"))
|
||||
(do (adv!) (parse-if-cmd)))
|
||||
((and (= typ "keyword") (= val "wait"))
|
||||
(do (adv!) (parse-wait-cmd)))
|
||||
((and (= typ "keyword") (= val "send"))
|
||||
(do (adv!) (parse-send-cmd)))
|
||||
((and (= typ "keyword") (= val "trigger"))
|
||||
(do (adv!) (parse-trigger-cmd)))
|
||||
((and (= typ "keyword") (= val "log"))
|
||||
(do (adv!) (parse-log-cmd)))
|
||||
((and (= typ "keyword") (= val "increment"))
|
||||
(do (adv!) (parse-inc-cmd)))
|
||||
((and (= typ "keyword") (= val "decrement"))
|
||||
(do (adv!) (parse-dec-cmd)))
|
||||
((and (= typ "keyword") (= val "hide"))
|
||||
(do (adv!) (parse-hide-cmd)))
|
||||
((and (= typ "keyword") (= val "show"))
|
||||
(do (adv!) (parse-show-cmd)))
|
||||
((and (= typ "keyword") (= val "transition"))
|
||||
(do (adv!) (parse-transition-cmd)))
|
||||
((and (= typ "keyword") (= val "repeat"))
|
||||
(do (adv!) (parse-repeat-cmd)))
|
||||
((and (= typ "keyword") (= val "fetch"))
|
||||
(do (adv!) (parse-fetch-cmd)))
|
||||
((and (= typ "keyword") (= val "call"))
|
||||
(do (adv!) (parse-call-cmd)))
|
||||
((and (= typ "keyword") (= val "take"))
|
||||
(do (adv!) (parse-take-cmd)))
|
||||
((and (= typ "keyword") (= val "settle"))
|
||||
(do (adv!) (list (quote settle))))
|
||||
((and (= typ "keyword") (= val "go"))
|
||||
(do (adv!) (parse-go-cmd)))
|
||||
(true (parse-expr))))))
|
||||
(define
|
||||
parse-cmd-list
|
||||
(fn
|
||||
()
|
||||
(define
|
||||
cl-collect
|
||||
(fn
|
||||
(acc)
|
||||
(let
|
||||
((cmd (parse-cmd)))
|
||||
(if
|
||||
(nil? cmd)
|
||||
acc
|
||||
(let
|
||||
((acc2 (append acc (list cmd))))
|
||||
(if (match-kw "then") (cl-collect acc2) acc2))))))
|
||||
(let
|
||||
((cmds (cl-collect (list))))
|
||||
(cond
|
||||
((= (len cmds) 0) nil)
|
||||
((= (len cmds) 1) (first cmds))
|
||||
(true (cons (quote do) cmds))))))
|
||||
(define
|
||||
parse-on-feat
|
||||
(fn
|
||||
()
|
||||
(let
|
||||
((event-name (get (adv!) "value")))
|
||||
(let
|
||||
((flt (if (= (tp-type) "bracket-open") (do (adv!) (let ((expr (parse-expr))) (if (= (tp-type) "bracket-close") (adv!) nil) expr)) nil)))
|
||||
(let
|
||||
((source (if (match-kw "from") (parse-expr) nil)))
|
||||
(let
|
||||
((body (parse-cmd-list)))
|
||||
(match-kw "end")
|
||||
(let
|
||||
((parts (list (quote on) event-name)))
|
||||
(let
|
||||
((parts (if source (append parts (list :from source)) parts)))
|
||||
(let
|
||||
((parts (if flt (append parts (list :filter flt)) parts)))
|
||||
(append parts (list body)))))))))))
|
||||
(define
|
||||
parse-init-feat
|
||||
(fn
|
||||
()
|
||||
(let
|
||||
((body (parse-cmd-list)))
|
||||
(match-kw "end")
|
||||
(list (quote init) body))))
|
||||
(define
|
||||
parse-feat
|
||||
(fn
|
||||
()
|
||||
(let
|
||||
((val (tp-val)))
|
||||
(cond
|
||||
((= val "on") (do (adv!) (parse-on-feat)))
|
||||
((= val "init") (do (adv!) (parse-init-feat)))
|
||||
(true (parse-cmd-list))))))
|
||||
(define
|
||||
coll-feats
|
||||
(fn
|
||||
(acc)
|
||||
(if
|
||||
(at-end?)
|
||||
acc
|
||||
(let
|
||||
((feat (parse-feat)))
|
||||
(if (nil? feat) acc (coll-feats (append acc (list feat))))))))
|
||||
(let
|
||||
((features (coll-feats (list))))
|
||||
(if
|
||||
(= (len features) 1)
|
||||
(first features)
|
||||
(cons (quote do) features))))))
|
||||
|
||||
;; ── Convenience: source string → AST ─────────────────────────────
|
||||
(define hs-compile (fn (src) (hs-parse (hs-tokenize src))))
|
||||
426
spec/tests/test-hyperscript-parser.sx
Normal file
426
spec/tests/test-hyperscript-parser.sx
Normal file
@@ -0,0 +1,426 @@
|
||||
;; _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))))
|
||||
Reference in New Issue
Block a user