Files
rose-ash/web/lib/browser.sx
giles 07bbcaf1bb OCaml VM browser: safe equality, thunk trampolining, platform functions, nav pipeline
Core runtime fixes:
- Safe equality (=, !=): physical equality for dicts/lambdas/signals,
  structural only for acyclic types. Prevents infinite loops on circular
  signal subscriber chains.
- contains?: same safe comparison (physical first, structural for simple types)
- Thunk trampolining in as_number and to_string: leaked thunks auto-resolve
  instead of showing <thunk> or erroring "Expected number, got thunk"
- Diagnostic first error: shows actual type received

Island hydration fixes:
- adapter-dom.sx: skip scope-emit for spreads inside islands (was tripling classes)
- schedule-idle: wrap callback to absorb requestIdleCallback deadline arg
- home-stepper: remove spread-specific highlighting (all tokens same style per step)

Platform functions (boot-helpers.sx):
- fetch-request: 3-arg interface (config, success-fn, error-fn) with promise chain
- build-request-body: form serialization for GET/POST
- strip-component-scripts / extract-response-css: SX text processing
- Navigation: bind-boost-link, bind-client-route-click via execute-request
- Loading state: show-indicator, disable-elements, clear-loading-state
- DOM extras: dom-remove, dom-attr-list (name/value pairs), dom-child-list (SX list),
  dom-is-active-element?, dom-is-input-element?, dom-is-child-of?, dom-on,
  dom-parse-html-document, dom-body-inner-html, create-script-clone
- All remaining stubs: csrf-token, loaded-component-names, observe-intersection,
  event-source-connect/listen, with-transition, cross-origin?, etc.

Navigation pipeline:
- browser-push-state/replace-state: accept 1-arg (URL only) or 3-arg
- boot.sx: wire popstate listener to handle-popstate
- URL updates working via handle-history + pushState fix

Morph debugging (WIP):
- dom-child-list returns proper SX list (was JS Array)
- dom-query accepts optional root element for scoped queries
- Navigation fetches and renders SX responses, URL updates, but morph
  doesn't replace content div (investigating dom-child-list on new elements)

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
2026-03-25 12:57:24 +00:00

228 lines
6.8 KiB
Plaintext

;; ==========================================================================
;; browser.sx — Browser API library functions
;;
;; Location, history, storage, cookies, timers, fetch — all expressed
;; using the host FFI primitives. Library functions, not primitives.
;; ==========================================================================
;; --------------------------------------------------------------------------
;; Location & navigation
;; --------------------------------------------------------------------------
(define browser-location-href
(fn ()
(host-get (host-get (dom-window) "location") "href")))
(define browser-location-pathname
(fn ()
(host-get (host-get (dom-window) "location") "pathname")))
(define browser-location-origin
(fn ()
(host-get (host-get (dom-window) "location") "origin")))
(define browser-same-origin?
(fn (url)
(starts-with? url (browser-location-origin))))
;; Extract pathname from a URL string using the URL API
(define url-pathname
(fn (url)
(host-get (host-new "URL" url (browser-location-origin)) "pathname")))
(define browser-push-state
(fn (url-or-state &rest rest)
(if (empty? rest)
;; Single arg: just URL
(host-call (host-get (dom-window) "history") "pushState" nil "" url-or-state)
;; Three args: state, title, url
(host-call (host-get (dom-window) "history") "pushState" url-or-state (first rest) (nth rest 1)))))
(define browser-replace-state
(fn (url-or-state &rest rest)
(if (empty? rest)
(host-call (host-get (dom-window) "history") "replaceState" nil "" url-or-state)
(host-call (host-get (dom-window) "history") "replaceState" url-or-state (first rest) (nth rest 1)))))
(define browser-reload
(fn ()
(host-call (host-get (dom-window) "location") "reload")))
(define browser-navigate
(fn (url)
(host-set! (host-get (dom-window) "location") "href" url)))
;; --------------------------------------------------------------------------
;; Storage
;; --------------------------------------------------------------------------
(define local-storage-get
(fn (key)
(host-call (host-get (dom-window) "localStorage") "getItem" key)))
(define local-storage-set
(fn (key val)
(host-call (host-get (dom-window) "localStorage") "setItem" key val)))
(define local-storage-remove
(fn (key)
(host-call (host-get (dom-window) "localStorage") "removeItem" key)))
;; --------------------------------------------------------------------------
;; Timers
;; --------------------------------------------------------------------------
(define set-timeout
(fn (fn-val ms)
(host-call (dom-window) "setTimeout" (host-callback fn-val) ms)))
(define set-interval
(fn (fn-val ms)
(host-call (dom-window) "setInterval" (host-callback fn-val) ms)))
(define clear-timeout
(fn (id)
(host-call (dom-window) "clearTimeout" id)))
(define clear-interval
(fn (id)
(host-call (dom-window) "clearInterval" id)))
(define request-animation-frame
(fn (fn-val)
(host-call (dom-window) "requestAnimationFrame" (host-callback fn-val))))
;; --------------------------------------------------------------------------
;; Fetch
;; --------------------------------------------------------------------------
(define fetch-request
(fn (url opts)
(host-call (dom-window) "fetch" url opts)))
(define new-abort-controller
(fn ()
(host-new "AbortController")))
(define controller-signal
(fn (controller)
(host-get controller "signal")))
(define controller-abort
(fn (controller)
(host-call controller "abort")))
;; --------------------------------------------------------------------------
;; Promises
;; --------------------------------------------------------------------------
(define promise-then
(fn (p on-resolve on-reject)
(let ((cb-resolve (host-callback on-resolve))
(cb-reject (if on-reject (host-callback on-reject) nil)))
(if cb-reject
(host-call (host-call p "then" cb-resolve) "catch" cb-reject)
(host-call p "then" cb-resolve)))))
(define promise-resolve
(fn (val)
(host-call (host-global "Promise") "resolve" val)))
(define promise-delayed
(fn (ms val)
(host-new "Promise" (host-callback
(fn (resolve)
(set-timeout (fn () (host-call resolve "call" nil val)) ms))))))
;; --------------------------------------------------------------------------
;; Dialogs & media
;; --------------------------------------------------------------------------
(define browser-confirm
(fn (msg) (host-call (dom-window) "confirm" msg)))
(define browser-prompt
(fn (msg default)
(host-call (dom-window) "prompt" msg default)))
(define browser-media-matches?
(fn (query)
(host-get (host-call (dom-window) "matchMedia" query) "matches")))
;; --------------------------------------------------------------------------
;; JSON
;; --------------------------------------------------------------------------
(define json-parse
(fn (s)
(host-call (host-global "JSON") "parse" s)))
;; --------------------------------------------------------------------------
;; Console
;; --------------------------------------------------------------------------
(define log-info
(fn (msg)
(host-call (host-global "console") "log" (str "[sx] " msg))))
(define log-warn
(fn (msg)
(host-call (host-global "console") "warn" (str "[sx] " msg))))
(define console-log
(fn (&rest args)
(host-call (host-global "console") "log"
(join " " (cons "[sx]" (map str args))))))
(define now-ms
(fn ()
(host-call (host-global "Date") "now")))
;; --------------------------------------------------------------------------
;; Scheduling
;; --------------------------------------------------------------------------
(define schedule-idle
(fn (f)
(let ((cb (host-callback (fn (_deadline) (f)))))
(if (host-get (dom-window) "requestIdleCallback")
(host-call (dom-window) "requestIdleCallback" cb)
(set-timeout cb 0)))))
;; --------------------------------------------------------------------------
;; Cookies
;; --------------------------------------------------------------------------
(define set-cookie
(fn (name value days)
(let ((d (or days 365))
(expires (host-call
(host-new "Date"
(+ (host-call (host-global "Date") "now")
(* d 864e5)))
"toUTCString")))
(host-set! (dom-document) "cookie"
(str name "="
(host-call nil "encodeURIComponent" value)
";expires=" expires ";path=/;SameSite=Lax")))))
(define get-cookie
(fn (name)
(let ((cookies (host-get (dom-document) "cookie"))
(match (host-call cookies "match"
(host-new "RegExp"
(str "(?:^|;\\s*)" name "=([^;]*)")))))
(if match
(host-call nil "decodeURIComponent" (host-get match 1))
nil))))