diff --git a/lib/hyperscript/compiler.sx b/lib/hyperscript/compiler.sx index 97f3642e..eafb94fe 100644 --- a/lib/hyperscript/compiler.sx +++ b/lib/hyperscript/compiler.sx @@ -165,7 +165,8 @@ catch-info finally-info having-info - of-filter-info) + of-filter-info + count-filter-info) (cond ((<= (len items) 1) (let @@ -183,7 +184,7 @@ (let ((wrapped-body (if catch-info (let ((var (make-symbol (nth catch-info 0))) (catch-body (hs-to-sx (nth catch-info 1)))) (if finally-info (list (quote do) (list (quote guard) (list var (list true catch-body)) compiled-body) (hs-to-sx finally-info)) (list (quote guard) (list var (list true catch-body)) compiled-body))) (if finally-info (list (quote do) compiled-body (hs-to-sx finally-info)) compiled-body)))) (let - ((handler (let ((uses-the-result? (fn (expr) (cond ((= expr (quote the-result)) true) ((list? expr) (some (fn (x) (uses-the-result? x)) expr)) (true false))))) (list (quote fn) (list (quote event)) (if (uses-the-result? wrapped-body) (list (quote let) (list (list (quote the-result) nil)) wrapped-body) wrapped-body))))) + ((handler (let ((uses-the-result? (fn (expr) (cond ((= expr (quote the-result)) true) ((list? expr) (some (fn (x) (uses-the-result? x)) expr)) (true false))))) (let ((base-handler (list (quote fn) (list (quote event)) (if (uses-the-result? wrapped-body) (list (quote let) (list (list (quote the-result) nil)) wrapped-body) wrapped-body)))) (if count-filter-info (let ((mn (get count-filter-info "min")) (mx (get count-filter-info "max"))) (list (quote let) (list (list (quote __hs-count) 0)) (list (quote fn) (list (quote event)) (list (quote begin) (list (quote set!) (quote __hs-count) (list (quote +) (quote __hs-count) 1)) (list (quote when) (if (= mx -1) (list (quote >=) (quote __hs-count) mn) (list (quote and) (list (quote >=) (quote __hs-count) mn) (list (quote <=) (quote __hs-count) mx))) (nth base-handler 2)))))) base-handler))))) (let ((on-call (if every? (list (quote hs-on-every) target event-name handler) (list (quote hs-on) target event-name handler)))) (cond @@ -233,7 +234,8 @@ catch-info finally-info having-info - of-filter-info)) + of-filter-info + count-filter-info)) ((= (first items) :filter) (scan-on (rest (rest items)) @@ -243,7 +245,8 @@ catch-info finally-info having-info - of-filter-info)) + of-filter-info + count-filter-info)) ((= (first items) :every) (scan-on (rest (rest items)) @@ -253,7 +256,8 @@ catch-info finally-info having-info - of-filter-info)) + of-filter-info + count-filter-info)) ((= (first items) :catch) (scan-on (rest (rest items)) @@ -263,7 +267,8 @@ (nth items 1) finally-info having-info - of-filter-info)) + of-filter-info + count-filter-info)) ((= (first items) :finally) (scan-on (rest (rest items)) @@ -273,7 +278,8 @@ catch-info (nth items 1) having-info - of-filter-info)) + of-filter-info + count-filter-info)) ((= (first items) :having) (scan-on (rest (rest items)) @@ -283,7 +289,8 @@ catch-info finally-info (nth items 1) - of-filter-info)) + of-filter-info + count-filter-info)) ((= (first items) :of-filter) (scan-on (rest (rest items)) @@ -293,6 +300,18 @@ catch-info finally-info having-info + (nth items 1) + count-filter-info)) + ((= (first items) :count-filter) + (scan-on + (rest (rest items)) + source + filter + every? + catch-info + finally-info + having-info + of-filter-info (nth items 1))) (true (scan-on @@ -303,8 +322,9 @@ catch-info finally-info having-info - of-filter-info))))) - (scan-on (rest parts) nil nil false nil nil nil nil))))) + of-filter-info + count-filter-info))))) + (scan-on (rest parts) nil nil false nil nil nil nil nil))))) (define emit-send (fn diff --git a/lib/hyperscript/parser.sx b/lib/hyperscript/parser.sx index 0ed783d8..ee9682be 100644 --- a/lib/hyperscript/parser.sx +++ b/lib/hyperscript/parser.sx @@ -2601,70 +2601,74 @@ (fn () (let - ((every? (match-kw "every"))) + ((every? (match-kw "every")) (first? (match-kw "first"))) (let ((event-name (parse-compound-event-name))) (let - ((of-filter (when (and (= event-name "mutation") (match-kw "of")) (cond ((and (= (tp-type) "ident") (or (= (tp-val) "attributes") (= (tp-val) "childList") (= (tp-val) "characterData"))) (let ((nm (tp-val))) (do (adv!) (dict "type" nm)))) ((= (tp-type) "attr") (let ((attrs (list (tp-val)))) (do (adv!) (define collect-or! (fn () (when (match-kw "or") (cond ((= (tp-type) "attr") (do (set! attrs (append attrs (list (tp-val)))) (adv!) (collect-or!))) (true (set! p (- p 1))))))) (collect-or!) (dict "type" "attrs" "attrs" attrs)))) (true nil))))) + ((count-filter (let ((mn nil) (mx nil)) (when first? (do (set! mn 1) (set! mx 1))) (when (= (tp-type) "number") (let ((n (parse-number (tp-val)))) (do (adv!) (set! mn n) (cond ((match-kw "to") (cond ((= (tp-type) "number") (let ((mv (parse-number (tp-val)))) (do (adv!) (set! mx mv)))) (true (set! mx n)))) ((match-kw "and") (cond ((match-kw "on") (set! mx -1)) (true (set! mx n)))) (true (set! mx n)))))) (if mn (dict "min" mn "max" mx) nil)))) (let - ((flt (if (= (tp-type) "bracket-open") (do (adv!) (let ((f (parse-expr))) (if (= (tp-type) "bracket-close") (adv!) nil) f)) nil))) + ((of-filter (when (and (= event-name "mutation") (match-kw "of")) (cond ((and (= (tp-type) "ident") (or (= (tp-val) "attributes") (= (tp-val) "childList") (= (tp-val) "characterData"))) (let ((nm (tp-val))) (do (adv!) (dict "type" nm)))) ((= (tp-type) "attr") (let ((attrs (list (tp-val)))) (do (adv!) (define collect-or! (fn () (when (match-kw "or") (cond ((= (tp-type) "attr") (do (set! attrs (append attrs (list (tp-val)))) (adv!) (collect-or!))) (true (set! p (- p 1))))))) (collect-or!) (dict "type" "attrs" "attrs" attrs)))) (true nil))))) (let - ((source (if (match-kw "from") (parse-expr) nil))) + ((flt (if (= (tp-type) "bracket-open") (do (adv!) (let ((f (parse-expr))) (if (= (tp-type) "bracket-close") (adv!) nil) f)) nil))) (let - ((h-margin nil) (h-threshold nil)) - (define - consume-having! - (fn - () - (cond - ((and (= (tp-type) "ident") (= (tp-val) "having")) - (do - (adv!) - (cond - ((and (= (tp-type) "ident") (= (tp-val) "margin")) - (do - (adv!) - (set! h-margin (parse-expr)) - (consume-having!))) - ((and (= (tp-type) "ident") (= (tp-val) "threshold")) - (do - (adv!) - (set! h-threshold (parse-expr)) - (consume-having!))) - (true nil)))) - (true nil)))) - (consume-having!) + ((source (if (match-kw "from") (parse-expr) nil))) (let - ((having (if (or h-margin h-threshold) (dict "margin" h-margin "threshold" h-threshold) nil))) + ((h-margin nil) (h-threshold nil)) + (define + consume-having! + (fn + () + (cond + ((and (= (tp-type) "ident") (= (tp-val) "having")) + (do + (adv!) + (cond + ((and (= (tp-type) "ident") (= (tp-val) "margin")) + (do + (adv!) + (set! h-margin (parse-expr)) + (consume-having!))) + ((and (= (tp-type) "ident") (= (tp-val) "threshold")) + (do + (adv!) + (set! h-threshold (parse-expr)) + (consume-having!))) + (true nil)))) + (true nil)))) + (consume-having!) (let - ((body (parse-cmd-list))) + ((having (if (or h-margin h-threshold) (dict "margin" h-margin "threshold" h-threshold) nil))) (let - ((catch-clause (if (match-kw "catch") (let ((var (let ((v (tp-val))) (adv!) v)) (handler (parse-cmd-list))) (list var handler)) nil)) - (finally-clause - (if - (match-kw "finally") - (parse-cmd-list) - nil))) - (match-kw "end") + ((body (parse-cmd-list))) (let - ((parts (list (quote on) event-name))) + ((catch-clause (if (match-kw "catch") (let ((var (let ((v (tp-val))) (adv!) v)) (handler (parse-cmd-list))) (list var handler)) nil)) + (finally-clause + (if + (match-kw "finally") + (parse-cmd-list) + nil))) + (match-kw "end") (let - ((parts (if every? (append parts (list :every true)) parts))) + ((parts (list (quote on) event-name))) (let - ((parts (if flt (append parts (list :filter flt)) parts))) + ((parts (if every? (append parts (list :every true)) parts))) (let - ((parts (if source (append parts (list :from source)) parts))) + ((parts (if flt (append parts (list :filter flt)) parts))) (let - ((parts (if of-filter (append parts (list :of-filter of-filter)) parts))) + ((parts (if source (append parts (list :from source)) parts))) (let - ((parts (if having (append parts (list :having having)) parts))) + ((parts (if count-filter (append parts (list :count-filter count-filter)) parts))) (let - ((parts (if catch-clause (append parts (list :catch catch-clause)) parts))) + ((parts (if of-filter (append parts (list :of-filter of-filter)) parts))) (let - ((parts (if finally-clause (append parts (list :finally finally-clause)) parts))) + ((parts (if having (append parts (list :having having)) parts))) (let - ((parts (append parts (list body)))) - parts)))))))))))))))))))) + ((parts (if catch-clause (append parts (list :catch catch-clause)) parts))) + (let + ((parts (if finally-clause (append parts (list :finally finally-clause)) parts))) + (let + ((parts (append parts (list body)))) + parts)))))))))))))))))))))) (define parse-init-feat (fn diff --git a/shared/static/wasm/sx/hs-compiler.sx b/shared/static/wasm/sx/hs-compiler.sx index 97f3642e..eafb94fe 100644 --- a/shared/static/wasm/sx/hs-compiler.sx +++ b/shared/static/wasm/sx/hs-compiler.sx @@ -165,7 +165,8 @@ catch-info finally-info having-info - of-filter-info) + of-filter-info + count-filter-info) (cond ((<= (len items) 1) (let @@ -183,7 +184,7 @@ (let ((wrapped-body (if catch-info (let ((var (make-symbol (nth catch-info 0))) (catch-body (hs-to-sx (nth catch-info 1)))) (if finally-info (list (quote do) (list (quote guard) (list var (list true catch-body)) compiled-body) (hs-to-sx finally-info)) (list (quote guard) (list var (list true catch-body)) compiled-body))) (if finally-info (list (quote do) compiled-body (hs-to-sx finally-info)) compiled-body)))) (let - ((handler (let ((uses-the-result? (fn (expr) (cond ((= expr (quote the-result)) true) ((list? expr) (some (fn (x) (uses-the-result? x)) expr)) (true false))))) (list (quote fn) (list (quote event)) (if (uses-the-result? wrapped-body) (list (quote let) (list (list (quote the-result) nil)) wrapped-body) wrapped-body))))) + ((handler (let ((uses-the-result? (fn (expr) (cond ((= expr (quote the-result)) true) ((list? expr) (some (fn (x) (uses-the-result? x)) expr)) (true false))))) (let ((base-handler (list (quote fn) (list (quote event)) (if (uses-the-result? wrapped-body) (list (quote let) (list (list (quote the-result) nil)) wrapped-body) wrapped-body)))) (if count-filter-info (let ((mn (get count-filter-info "min")) (mx (get count-filter-info "max"))) (list (quote let) (list (list (quote __hs-count) 0)) (list (quote fn) (list (quote event)) (list (quote begin) (list (quote set!) (quote __hs-count) (list (quote +) (quote __hs-count) 1)) (list (quote when) (if (= mx -1) (list (quote >=) (quote __hs-count) mn) (list (quote and) (list (quote >=) (quote __hs-count) mn) (list (quote <=) (quote __hs-count) mx))) (nth base-handler 2)))))) base-handler))))) (let ((on-call (if every? (list (quote hs-on-every) target event-name handler) (list (quote hs-on) target event-name handler)))) (cond @@ -233,7 +234,8 @@ catch-info finally-info having-info - of-filter-info)) + of-filter-info + count-filter-info)) ((= (first items) :filter) (scan-on (rest (rest items)) @@ -243,7 +245,8 @@ catch-info finally-info having-info - of-filter-info)) + of-filter-info + count-filter-info)) ((= (first items) :every) (scan-on (rest (rest items)) @@ -253,7 +256,8 @@ catch-info finally-info having-info - of-filter-info)) + of-filter-info + count-filter-info)) ((= (first items) :catch) (scan-on (rest (rest items)) @@ -263,7 +267,8 @@ (nth items 1) finally-info having-info - of-filter-info)) + of-filter-info + count-filter-info)) ((= (first items) :finally) (scan-on (rest (rest items)) @@ -273,7 +278,8 @@ catch-info (nth items 1) having-info - of-filter-info)) + of-filter-info + count-filter-info)) ((= (first items) :having) (scan-on (rest (rest items)) @@ -283,7 +289,8 @@ catch-info finally-info (nth items 1) - of-filter-info)) + of-filter-info + count-filter-info)) ((= (first items) :of-filter) (scan-on (rest (rest items)) @@ -293,6 +300,18 @@ catch-info finally-info having-info + (nth items 1) + count-filter-info)) + ((= (first items) :count-filter) + (scan-on + (rest (rest items)) + source + filter + every? + catch-info + finally-info + having-info + of-filter-info (nth items 1))) (true (scan-on @@ -303,8 +322,9 @@ catch-info finally-info having-info - of-filter-info))))) - (scan-on (rest parts) nil nil false nil nil nil nil))))) + of-filter-info + count-filter-info))))) + (scan-on (rest parts) nil nil false nil nil nil nil nil))))) (define emit-send (fn diff --git a/shared/static/wasm/sx/hs-parser.sx b/shared/static/wasm/sx/hs-parser.sx index 0ed783d8..ee9682be 100644 --- a/shared/static/wasm/sx/hs-parser.sx +++ b/shared/static/wasm/sx/hs-parser.sx @@ -2601,70 +2601,74 @@ (fn () (let - ((every? (match-kw "every"))) + ((every? (match-kw "every")) (first? (match-kw "first"))) (let ((event-name (parse-compound-event-name))) (let - ((of-filter (when (and (= event-name "mutation") (match-kw "of")) (cond ((and (= (tp-type) "ident") (or (= (tp-val) "attributes") (= (tp-val) "childList") (= (tp-val) "characterData"))) (let ((nm (tp-val))) (do (adv!) (dict "type" nm)))) ((= (tp-type) "attr") (let ((attrs (list (tp-val)))) (do (adv!) (define collect-or! (fn () (when (match-kw "or") (cond ((= (tp-type) "attr") (do (set! attrs (append attrs (list (tp-val)))) (adv!) (collect-or!))) (true (set! p (- p 1))))))) (collect-or!) (dict "type" "attrs" "attrs" attrs)))) (true nil))))) + ((count-filter (let ((mn nil) (mx nil)) (when first? (do (set! mn 1) (set! mx 1))) (when (= (tp-type) "number") (let ((n (parse-number (tp-val)))) (do (adv!) (set! mn n) (cond ((match-kw "to") (cond ((= (tp-type) "number") (let ((mv (parse-number (tp-val)))) (do (adv!) (set! mx mv)))) (true (set! mx n)))) ((match-kw "and") (cond ((match-kw "on") (set! mx -1)) (true (set! mx n)))) (true (set! mx n)))))) (if mn (dict "min" mn "max" mx) nil)))) (let - ((flt (if (= (tp-type) "bracket-open") (do (adv!) (let ((f (parse-expr))) (if (= (tp-type) "bracket-close") (adv!) nil) f)) nil))) + ((of-filter (when (and (= event-name "mutation") (match-kw "of")) (cond ((and (= (tp-type) "ident") (or (= (tp-val) "attributes") (= (tp-val) "childList") (= (tp-val) "characterData"))) (let ((nm (tp-val))) (do (adv!) (dict "type" nm)))) ((= (tp-type) "attr") (let ((attrs (list (tp-val)))) (do (adv!) (define collect-or! (fn () (when (match-kw "or") (cond ((= (tp-type) "attr") (do (set! attrs (append attrs (list (tp-val)))) (adv!) (collect-or!))) (true (set! p (- p 1))))))) (collect-or!) (dict "type" "attrs" "attrs" attrs)))) (true nil))))) (let - ((source (if (match-kw "from") (parse-expr) nil))) + ((flt (if (= (tp-type) "bracket-open") (do (adv!) (let ((f (parse-expr))) (if (= (tp-type) "bracket-close") (adv!) nil) f)) nil))) (let - ((h-margin nil) (h-threshold nil)) - (define - consume-having! - (fn - () - (cond - ((and (= (tp-type) "ident") (= (tp-val) "having")) - (do - (adv!) - (cond - ((and (= (tp-type) "ident") (= (tp-val) "margin")) - (do - (adv!) - (set! h-margin (parse-expr)) - (consume-having!))) - ((and (= (tp-type) "ident") (= (tp-val) "threshold")) - (do - (adv!) - (set! h-threshold (parse-expr)) - (consume-having!))) - (true nil)))) - (true nil)))) - (consume-having!) + ((source (if (match-kw "from") (parse-expr) nil))) (let - ((having (if (or h-margin h-threshold) (dict "margin" h-margin "threshold" h-threshold) nil))) + ((h-margin nil) (h-threshold nil)) + (define + consume-having! + (fn + () + (cond + ((and (= (tp-type) "ident") (= (tp-val) "having")) + (do + (adv!) + (cond + ((and (= (tp-type) "ident") (= (tp-val) "margin")) + (do + (adv!) + (set! h-margin (parse-expr)) + (consume-having!))) + ((and (= (tp-type) "ident") (= (tp-val) "threshold")) + (do + (adv!) + (set! h-threshold (parse-expr)) + (consume-having!))) + (true nil)))) + (true nil)))) + (consume-having!) (let - ((body (parse-cmd-list))) + ((having (if (or h-margin h-threshold) (dict "margin" h-margin "threshold" h-threshold) nil))) (let - ((catch-clause (if (match-kw "catch") (let ((var (let ((v (tp-val))) (adv!) v)) (handler (parse-cmd-list))) (list var handler)) nil)) - (finally-clause - (if - (match-kw "finally") - (parse-cmd-list) - nil))) - (match-kw "end") + ((body (parse-cmd-list))) (let - ((parts (list (quote on) event-name))) + ((catch-clause (if (match-kw "catch") (let ((var (let ((v (tp-val))) (adv!) v)) (handler (parse-cmd-list))) (list var handler)) nil)) + (finally-clause + (if + (match-kw "finally") + (parse-cmd-list) + nil))) + (match-kw "end") (let - ((parts (if every? (append parts (list :every true)) parts))) + ((parts (list (quote on) event-name))) (let - ((parts (if flt (append parts (list :filter flt)) parts))) + ((parts (if every? (append parts (list :every true)) parts))) (let - ((parts (if source (append parts (list :from source)) parts))) + ((parts (if flt (append parts (list :filter flt)) parts))) (let - ((parts (if of-filter (append parts (list :of-filter of-filter)) parts))) + ((parts (if source (append parts (list :from source)) parts))) (let - ((parts (if having (append parts (list :having having)) parts))) + ((parts (if count-filter (append parts (list :count-filter count-filter)) parts))) (let - ((parts (if catch-clause (append parts (list :catch catch-clause)) parts))) + ((parts (if of-filter (append parts (list :of-filter of-filter)) parts))) (let - ((parts (if finally-clause (append parts (list :finally finally-clause)) parts))) + ((parts (if having (append parts (list :having having)) parts))) (let - ((parts (append parts (list body)))) - parts)))))))))))))))))))) + ((parts (if catch-clause (append parts (list :catch catch-clause)) parts))) + (let + ((parts (if finally-clause (append parts (list :finally finally-clause)) parts))) + (let + ((parts (append parts (list body)))) + parts)))))))))))))))))))))) (define parse-init-feat (fn diff --git a/spec/tests/test-hyperscript-behavioral.sx b/spec/tests/test-hyperscript-behavioral.sx index 6b6d55c2..d211dcf2 100644 --- a/spec/tests/test-hyperscript-behavioral.sx +++ b/spec/tests/test-hyperscript-behavioral.sx @@ -8820,11 +8820,29 @@ (hs-activate! _el-pf) )) (deftest "can filter events based on count" - (error "SKIP (skip-list): can filter events based on count")) + (hs-cleanup!) + (let ((_el-div (dom-create-element "div"))) + (dom-set-attr _el-div "_" "on click 1 put 1 + my.innerHTML as Int into my.innerHTML") + (dom-set-inner-html _el-div "0") + (dom-append (dom-body) _el-div) + (hs-activate! _el-div) + )) (deftest "can filter events based on count range" - (error "SKIP (skip-list): can filter events based on count range")) + (hs-cleanup!) + (let ((_el-div (dom-create-element "div"))) + (dom-set-attr _el-div "_" "on click 1 to 2 put 1 + my.innerHTML as Int into my.innerHTML") + (dom-set-inner-html _el-div "0") + (dom-append (dom-body) _el-div) + (hs-activate! _el-div) + )) (deftest "can filter events based on unbounded count range" - (error "SKIP (skip-list): can filter events based on unbounded count range")) + (hs-cleanup!) + (let ((_el-div (dom-create-element "div"))) + (dom-set-attr _el-div "_" "on click 2 and on put 1 + my.innerHTML as Int into my.innerHTML") + (dom-set-inner-html _el-div "0") + (dom-append (dom-body) _el-div) + (hs-activate! _el-div) + )) (deftest "can fire an event on load" (hs-cleanup!) (let ((_el-d1 (dom-create-element "div"))) @@ -8951,7 +8969,13 @@ (hs-activate! _el-div) )) (deftest "can mix ranges" - (error "SKIP (skip-list): can mix ranges")) + (hs-cleanup!) + (let ((_el-div (dom-create-element "div"))) + (dom-set-attr _el-div "_" "on click 1 put \"one\" into my.innerHTML on click 3 put \"three\" into my.innerHTML on click 2 put \"two\" into my.innerHTML") + (dom-set-inner-html _el-div "0") + (dom-append (dom-body) _el-div) + (hs-activate! _el-div) + )) (deftest "can pick detail fields out by name" (error "SKIP (skip-list): can pick detail fields out by name")) (deftest "can pick event properties out by name" @@ -9121,7 +9145,13 @@ (deftest "multiple event handlers at a time are allowed to execute with the every keyword" (error "SKIP (skip-list): multiple event handlers at a time are allowed to execute with the every keyword")) (deftest "on first click fires only once" - (error "SKIP (skip-list): on first click fires only once")) + (hs-cleanup!) + (let ((_el-div (dom-create-element "div"))) + (dom-set-attr _el-div "_" "on first click put 1 + my.innerHTML as Int into my.innerHTML") + (dom-set-inner-html _el-div "0") + (dom-append (dom-body) _el-div) + (hs-activate! _el-div) + )) (deftest "on intersection fires when the element is in the viewport" (hs-cleanup!) (let ((_el-d (dom-create-element "div"))) diff --git a/tests/playwright/generate-sx-tests.py b/tests/playwright/generate-sx-tests.py index 9e9d4864..b8c89d9c 100644 --- a/tests/playwright/generate-sx-tests.py +++ b/tests/playwright/generate-sx-tests.py @@ -110,10 +110,6 @@ SKIP_TEST_NAMES = { "can pick event properties out by name", "can be in a top level script tag", "multiple event handlers at a time are allowed to execute with the every keyword", - "can filter events based on count", - "can filter events based on count range", - "can filter events based on unbounded count range", - "can mix ranges", "each behavior installation has its own event queue", "can catch exceptions thrown in js functions", "can catch exceptions thrown in hyperscript functions", @@ -129,7 +125,6 @@ SKIP_TEST_NAMES = { "can ignore when target doesn't exist", "can ignore when target doesn\\'t exist", "can handle an or after a from clause", - "on first click fires only once", "supports \"elsewhere\" modifier", "supports \"from elsewhere\" modifier", # upstream 'def' category — namespaced def + dynamic `me` inside callee