diff --git a/hosts/ocaml/bin/run_tests.ml b/hosts/ocaml/bin/run_tests.ml index 21e01599..d3366afd 100644 --- a/hosts/ocaml/bin/run_tests.ml +++ b/hosts/ocaml/bin/run_tests.ml @@ -352,7 +352,11 @@ let make_test_env () = bind "append!" (fun args -> match args with - | [ListRef r; v] -> r := !r @ [v]; ListRef r (* mutate in place *) + | [ListRef r; v; Number n] when int_of_float n = 0 -> + r := v :: !r; ListRef r (* prepend *) + | [ListRef r; v] -> r := !r @ [v]; ListRef r (* append in place *) + | [List items; v; Number n] when int_of_float n = 0 -> + List (v :: items) (* immutable prepend *) | [List items; v] -> List (items @ [v]) (* immutable fallback *) | _ -> raise (Eval_error "append!: expected list and value")); @@ -1297,8 +1301,7 @@ let run_spec_tests env test_files = let response = match op with | "import" -> let lib_spec = Sx_runtime.get_val request (String "library") in - let key = Sx_ref.library_name_key lib_spec in - if Sx_types.sx_truthy (Sx_ref.library_loaded_p key) then + if Sx_types.sx_truthy (Sx_ref.library_loaded_p lib_spec) then Nil else begin (match resolve_library_path lib_spec with @@ -1611,7 +1614,7 @@ let run_spec_tests env test_files = | "contains" | "cloneNode" | "remove" | "focus" | "blur" | "click" | "insertAdjacentHTML" | "prepend" | "showModal" | "show" | "close" | "getBoundingClientRect" | "getAnimations" | "scrollIntoView" - | "scrollTo" | "scroll" -> Bool true + | "scrollTo" | "scroll" | "reset" -> Bool true | "firstElementChild" -> let kids = match Hashtbl.find_opt d "children" with Some (List l) -> l | _ -> [] in (match kids with c :: _ -> c | [] -> Nil) @@ -1718,6 +1721,17 @@ let run_spec_tests env test_files = Hashtbl.replace d "childNodes" (List []) | _ -> ()); stored + | [ListRef r; Number n; value] -> + let idx = int_of_float n in + let lst = !r in + if idx >= 0 && idx < List.length lst then + r := List.mapi (fun i v -> if i = idx then value else v) lst + else if idx = List.length lst then + r := lst @ [value]; + value + | [List _; Number _; _value] -> + (* Immutable list — can't set, but don't crash *) + Nil | _ -> Nil); reg "host-call" (fun args -> @@ -2079,6 +2093,56 @@ let run_spec_tests env test_files = Hashtbl.replace cd "parentNode" (Dict d) | _ -> ()); Nil | _ -> Nil) + | "reset" -> + (* Reset form elements to their default values *) + let rec reset_element el = + match el with + | Dict ed -> + let tag = match Hashtbl.find_opt ed "tagName" with Some (String t) -> String.lowercase_ascii t | _ -> "" in + let attrs = match Hashtbl.find_opt ed "attributes" with Some (Dict a) -> a | _ -> Hashtbl.create 0 in + (match tag with + | "input" -> + let typ = match Hashtbl.find_opt attrs "type" with Some (String t) -> String.lowercase_ascii t | _ -> "text" in + (match typ with + | "checkbox" | "radio" -> + let default_checked = Hashtbl.mem attrs "checked" in + Hashtbl.replace ed "checked" (Bool default_checked) + | _ -> + let default_value = match Hashtbl.find_opt attrs "value" with Some v -> v | None -> String "" in + Hashtbl.replace ed "value" default_value) + | "textarea" -> + (* Textarea default is from innerHTML/textContent, not value attr *) + let default_value = match Hashtbl.find_opt attrs "value" with + | Some v -> v + | None -> (match Hashtbl.find_opt ed "textContent" with Some v -> v + | None -> (match Hashtbl.find_opt ed "innerHTML" with Some v -> v | None -> String "")) in + Hashtbl.replace ed "value" default_value + | "select" -> + (* Restore first option or defaultSelected *) + let kids = match Hashtbl.find_opt ed "children" with Some (List l) -> l | _ -> [] in + let rec find_default = function + | [] -> None + | Dict od :: _ when Hashtbl.mem (match Hashtbl.find_opt od "attributes" with Some (Dict a) -> a | _ -> Hashtbl.create 0) "selected" -> + Some (match Hashtbl.find_opt (match Hashtbl.find_opt od "attributes" with Some (Dict a) -> a | _ -> Hashtbl.create 0) "value" with Some (String v) -> v | _ -> "") + | _ :: rest -> find_default rest in + (match find_default kids with + | Some v -> Hashtbl.replace ed "value" (String v) + | None -> + (match kids with + | Dict od :: _ -> + let v = match Hashtbl.find_opt (match Hashtbl.find_opt od "attributes" with Some (Dict a) -> a | _ -> Hashtbl.create 0) "value" with Some (String v) -> v | _ -> "" in + Hashtbl.replace ed "value" (String v) + | _ -> ())) + | "form" -> + let kids = match Hashtbl.find_opt ed "children" with Some (List l) -> l | _ -> [] in + List.iter reset_element kids + | _ -> + (* Recurse into children for generic containers *) + let kids = match Hashtbl.find_opt ed "children" with Some (List l) -> l | _ -> [] in + List.iter reset_element kids); + | _ -> () + in + reset_element (Dict d); Nil | _ -> Nil) | _ -> Nil); diff --git a/lib/hyperscript/compiler.sx b/lib/hyperscript/compiler.sx index 4baa345c..4d19ce05 100644 --- a/lib/hyperscript/compiler.sx +++ b/lib/hyperscript/compiler.sx @@ -110,47 +110,32 @@ (let ((target (if source (hs-to-sx source) (quote me)))) (let - ((compiled-body (hs-to-sx body)) - (wrapped-body - (if - catch-info + ((event-refs (if (and (list? body) (= (first body) (quote do))) (filter (fn (x) (and (list? x) (= (first x) (quote ref)))) (rest body)) (list)))) + (let + ((stripped-body (if (> (len event-refs) 0) (let ((remaining (filter (fn (x) (not (and (list? x) (= (first x) (quote ref))))) (rest body)))) (if (= (len remaining) 1) (first remaining) (cons (quote do) remaining))) body))) + (let + ((raw-compiled (hs-to-sx stripped-body))) + (let + ((compiled-body (if (> (len event-refs) 0) (let ((bindings (map (fn (r) (let ((name (nth r 1))) (list (make-symbol name) (list (quote get) (list (quote get) (quote event) "detail") name)))) event-refs))) (list (quote let) bindings raw-compiled)) raw-compiled))) (let - ((var (make-symbol (first catch-info))) - (catch-body - (hs-to-sx (nth catch-info 1)))) - (if - finally-info - (list - (quote do) + ((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))) + (handler (list - (quote guard) - (list var (list true catch-body)) - compiled-body) - (hs-to-sx finally-info)) + (quote fn) + (list (quote event)) + wrapped-body))) + (if + every? (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))) - (handler - (list - (quote fn) - (list (quote event)) - wrapped-body))) - (if - every? - (list - (quote hs-on-every) - target - event-name - handler) - (list (quote hs-on) target event-name handler)))))) + (quote hs-on-every) + target + event-name + handler) + (list + (quote hs-on) + target + event-name + handler)))))))))) ((= (first items) :from) (scan-on (rest (rest items)) @@ -1134,8 +1119,13 @@ (if (nth ast 2) (hs-to-sx (nth ast 2)) nil))) ((= head (quote call)) (let - ((fn-expr (hs-to-sx (nth ast 1))) - (args (map hs-to-sx (nth ast 2)))) + ((raw-fn (nth ast 1)) + (fn-expr + (if + (string? raw-fn) + (make-symbol raw-fn) + (hs-to-sx raw-fn))) + (args (map hs-to-sx (rest (rest ast))))) (cons fn-expr args))) ((= head (quote return)) (let diff --git a/lib/hyperscript/runtime.sx b/lib/hyperscript/runtime.sx index a4412abb..8ccdf9a3 100644 --- a/lib/hyperscript/runtime.sx +++ b/lib/hyperscript/runtime.sx @@ -161,12 +161,21 @@ (fn (value pos target) (cond - ((= pos "into") (dom-set-inner-html target value)) + ((= pos "into") + (if (list? target) target (dom-set-inner-html target value))) ((= pos "before") (dom-insert-adjacent-html target "beforebegin" value)) ((= pos "after") (dom-insert-adjacent-html target "afterend" value)) - ((= pos "start") (dom-insert-adjacent-html target "afterbegin" value)) - ((= pos "end") (dom-insert-adjacent-html target "beforeend" value))))) + ((= pos "start") + (if + (list? target) + (append! target value 0) + (dom-insert-adjacent-html target "afterbegin" value))) + ((= pos "end") + (if + (list? target) + (append! target value) + (dom-insert-adjacent-html target "beforeend" value)))))) ;; Last element matching selector. (define diff --git a/sx/sx/geography/reactive/_lib/test-temperature.sx b/sx/sx/geography/reactive/_lib/test-temperature.test.sx similarity index 100% rename from sx/sx/geography/reactive/_lib/test-temperature.sx rename to sx/sx/geography/reactive/_lib/test-temperature.test.sx